File: x12cgi_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 (139 lines) | stat: -rwxr-xr-x 3,367 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
#!/usr/bin/perl -w
#
# @(#)$Id: x12cgi_noform.pl,v 100.1 2002/02/08 22:50:15 jleffler Exp $
#
# Simple example CGI script using DBI and DBD::Informix
#
# 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';
	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( 'Customer Report' ),
		"\n<TABLE>\n",
		$query->TR( { '-valign'=>'top' }, 
			$query->th( { '-align'=>'left' }, [
				'Number',
				'Last Name',
				'First Name',
				'Company'
			] ),
			$query->th( { '-align'=>'left', '-colspan'=>'2' },
				'Address'
			),
			$query->th( { '-align'=>'left' }, [
				'City',
				'State',
				'Zipcode',
				'Phone'
			] )
		);

	# fetch records from the database
	while ( $sth->fetch() ) {
		# Convert NULLS into non-breaking spaces (Perl-ish aka obscure!)
		map { $$_ = "&nbsp;" unless defined $$_ } @cols;
		# print values as table cells
		print
			$query->TR( { '-valign'=>'top' },
				$query->td( [
					$customer_num,
					$lname,
					$fname,
					$company,
					$address1,
					$address2,
					$city,
					$state,
					$zipcode,
					$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();

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

}

1; # notify Perl that the script loaded successfully