File: x13cgi_noform.pl

package info (click to toggle)
libdbd-informix-perl 2003.04-3
  • links: PTS
  • area: contrib
  • in suites: etch, etch-m68k, sarge
  • size: 1,232 kB
  • ctags: 467
  • sloc: perl: 7,349; ansic: 5,340; sh: 184; makefile: 58
file content (147 lines) | stat: -rwxr-xr-x 3,949 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
#!/usr/bin/perl -w
#
# @(#)$Id: x13cgi_noform.pl,v 100.1 2002/02/08 22:50:16 jleffler Exp $
#
# Slightly more sophisticated post-processing example CGI script
#
# Copyright 1998 Jonathan Leffler
# Copyright 2000 Informix Software Inc
# Copyright 2002 IBM

# load standard Perl modules
use strict;
use DBI;
use Apache;

# check whether the script is running with mod_perl
if ( exists( $ENV{ 'MOD_PERL' } ) ) {
	# use the CGI class for mod_perl
	use CGI::Apache;
}
else {
	# use the generic CGI class
	use CGI;
}

use CGI::Carp;

# Run the rest of the script in a block so there are no globals.
# Globals are shared across scripts in mod_perl.
{

	# the environment variables were set in the Apache configuration
	# file rather than here

	# instantiate a CGI object
	my $query = undef;
	if ( exists( $ENV{MOD_PERL} ) ) {
		# instantiate a CGI object for mod_perl
		$query = new CGI::Apache;
	}
	else {
		# instantiate a generic CGI object
		$query = new CGI;
	}

	#  output the http header and html heading
	print
		$query->header(),
		$query->start_html( { '-title'=>'Customer Report' } );

	# connect to the database, instantiating a database handler
	# and activating an automatic exit and notification on errors
	my $dbh=DBI->connect('dbi:Informix:stores', '', '',
		{ 'PrintError'=>1, 'RaiseError'=>1 }
	) or die "Could not connect, stopped\n";

	# prepare the select statement
	my $st_text = 'SELECT * FROM Customer ORDER BY Lname, Fname, Company, Customer_num';
	my $sth = $dbh->prepare( $st_text ) or
			die "Could not prepare $st_text; stopped";

	# open the cursor
	$sth->execute() or die "Failed to open cursor for SELECT statment\n";

	# bind columns to variables
	my (
		$customer_num, $fname, $lname, $company,
		$address1, $address2, $city, $state, $zipcode, $phone
	);
    my @cols = ( \$customer_num, \$fname, \$lname, \$company,
		\$address1, \$address2, \$city, \$state, \$zipcode, \$phone );
	$sth->bind_columns(undef, @cols);

	# chop blanks from char columns
	$sth->{ ChopBlanks } = 1;

	# Start a table with a row of table header rows.
	# Encode the <table> tag manually rather than calling
	# $query->table() to avoid printing the entire table at once
	print
		$query->h1({ align=>'center' }, 'Customer Report' ),
		"\n<TABLE>\n",
		$query->TR( { '-valign'=>'top' }, 
			$query->th( { '-align'=>'left' }, [
				'Name',
				'Company',
				'Address',
				'Phone'
			] )
		);

	# fetch records from the database
	while ( $sth->fetch() ) {
		# Convert NULLS into empty strings (Perl-ish aka obscure!)
		map { $$_ = "" unless defined $$_ } @cols;
		my ($name) = "$lname, $fname";
		my ($addr) = "$address1" . (($address2 eq "") ? "" : ", $address2") .
						", $city $state $zipcode";
		# print values as table cells
		print
			$query->TR( { '-valign'=>'top' },
				$query->td( [
					$name,
					$company,
					$addr,
					$phone
				] )
			);
	}

	# close the table
	print "\n</TABLE>\n";

	# This free statement is not strictly necessary in DBD::Informix
	# 0.60 as cursors are auto-finished when the last row is fetched.
	# It is needed in earlier versions; it does no damage in later ones.
	$sth->finish();

	# disconnect from the server
	$dbh->disconnect();

	print "\n<HR>\n";

	sub ordinal
	{
		my($val) = @_;
		my($lst) = $val % 10;
		my(@suffix) = ("th", "st", "nd", "rd");
		$lst = 0 if ($lst > 3 || ($val % 100 >= 11 && $val % 100 <= 13));
		return "${val}$suffix[$lst]";
	}

	my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
	$year += 1900;
	my $month = (qw(January February March April May June July August September October November December))[$mon];
	my $weekday = (qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday))[$wday];
	my $daynum = ordinal($day);
	print CGI::center("Data extracted at: $weekday, $daynum $month $year at $hour:$min:$sec UTC\n");

	print "\n<HR>\n";

	# finish the html page
	print $query->end_html();

}

1; # notify Perl that the script loaded successfully