summaryrefslogtreecommitdiff
path: root/install/5.005/DBD-Pg-1.22-fixvercmp/eg
diff options
context:
space:
mode:
Diffstat (limited to 'install/5.005/DBD-Pg-1.22-fixvercmp/eg')
-rwxr-xr-xinstall/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl70
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl74
-rw-r--r--install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch82
3 files changed, 0 insertions, 226 deletions
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl
deleted file mode 100755
index b084f70f5..000000000
--- a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/ApacheDBI.pl
+++ /dev/null
@@ -1,70 +0,0 @@
-#!/usr/local/bin/perl
-
-# $Id: ApacheDBI.pl,v 1.1 2004-04-29 09:21:28 ivan Exp $
-
-# don't forget to create in postgres the user who is running
-# the httpd, eg 'createuser nobody' !
-#
-# demo script, tested with:
-# - PostgreSQL-7.1.1
-# - apache_1.3.12
-# - mod_perl-1.23
-# - perl5.6.0
-# - DBI-1.14
-
-use CGI;
-use DBI;
-use strict;
-
-my $query = new CGI;
-
-print $query->header,
- $query->start_html(-title=>'A Simple Example'),
- $query->startform,
- "<CENTER><H3>Testing Module DBI</H3></CENTER>",
- "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>",
- "<TR><TD>Enter the data source: </TD>",
- "<TD>", $query->textfield(-name=>'data_source', -size=>40, -default=>'dbi:Pg:dbname=template1'), "</TD>",
- "</TR>",
- "<TR><TD>Enter the user name: </TD>",
- "<TD>", $query->textfield(-name=>'username'), "</TD>",
- "</TR>",
- "<TR><TD>Enter the password: </TD>",
- "<TD>", $query->textfield(-name=>'auth'), "</TD>",
- "</TR>",
- "<TR><TD>Enter the select command: </TD>",
- "<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>",
- "</TR>",
- "</TABLE></CENTER><P>",
- "<CENTER>", $query->submit(-value=>'Submit'), "</CENTER>",
- $query->endform;
-
-if ($query->param) {
-
- my $data_source = $query->param('data_source');
- my $username = $query->param('username');
- my $auth = $query->param('auth');
- my $cmd = $query->param('cmd');
- my $dbh = DBI->connect($data_source, $username, $auth);
- if ($dbh) {
- my $sth = $dbh->prepare($cmd);
- my $ret = $sth->execute;
- if ($ret) {
- my($i, $ary_ref);
- print "<P><CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n";
- while ($ary_ref = $sth->fetchrow_arrayref) {
- print "<TR><TD>", join("</TD><TD>", @$ary_ref), "</TD></TR>\n";
- }
- print "</TABLE></CENTER><P>\n";
- $sth->finish;
- } else {
- print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n";
- }
- $dbh->disconnect;
- } else {
- print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n";
- }
-}
-
-print $query->end_html;
-
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl
deleted file mode 100644
index 6192c4926..000000000
--- a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl
+++ /dev/null
@@ -1,74 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-use DBI;
-use DBD::Pg;
-
-my $dsn = "dbname=p1";
-my $dbh = DBI->connect('dbi:Pg:dbname=p1', undef, undef, { AutoCommit => 1 });
-
-my $buf = 'abcdefghijklmnopqrstuvwxyz' x 400;
-
-my $id = write_blob($dbh, undef, $buf);
-
-my $dat = read_blob($dbh, $id);
-
-print "Done\n";
-
-sub write_blob {
- my ($dbh, $lobj_id, $data) = @_;
-
- # begin transaction
- $dbh->{AutoCommit} = 0;
-
- # Create a new lo if we are not passed an lo object ID.
- unless ($lobj_id) {
- # Create the object.
- $lobj_id = $dbh->func($dbh->{'pg_INV_WRITE'}, 'lo_creat');
- }
-
- # Open it to get a file descriptor.
- my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_WRITE'}, 'lo_open');
-
- $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
-
- # Write some data to it.
- my $len = $dbh->func($lobj_fd, $data, length($data), 'lo_write');
-
- die "Errors writing lo\n" if $len != length($data);
-
- # Close 'er up.
- $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
-
- # end transaction
- $dbh->{AutoCommit} = 1;
-
- return $lobj_id;
-}
-
-sub read_blob {
- my ($dbh, $lobj_id) = @_;
- my $data = '';
- my $read_len = 256;
- my $chunk = '';
-
- # begin transaction
- $dbh->{AutoCommit} = 0;
-
- my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_READ'}, 'lo_open');
-
- $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
-
- # Pull out all the data.
- while ($dbh->func($lobj_fd, $chunk, $read_len, 'lo_read')) {
- $data .= $chunk;
- }
-
- $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
-
- # end transaction
- $dbh->{AutoCommit} = 1;
-
- return $data;
-}
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch b/install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch
deleted file mode 100644
index 6f8acf800..000000000
--- a/install/5.005/DBD-Pg-1.22-fixvercmp/eg/notify_test.patch
+++ /dev/null
@@ -1,82 +0,0 @@
-diff -r --unified DBD-Pg-1.00/test.pl DBD-Pg-1.00.alex/test.pl
---- DBD-Pg-1.00/test.pl Sun May 27 10:10:13 2001
-+++ DBD-Pg-1.00.alex/test.pl Sun Jun 10 15:38:09 2001
-@@ -40,7 +40,7 @@
- my $dsn_main = "dbi:Pg:dbname=$dbmain";
- my $dsn_test = "dbi:Pg:dbname=$dbtest";
-
--my ($dbh0, $dbh, $sth);
-+my ($dbh0, $dbh, $dbh1, $sth);
-
- #DBI->trace(3); # make your choice
-
-@@ -445,16 +445,56 @@
- # end transaction
- $dbh->{AutoCommit} = 1;
-
-+# compare large objects
-+
- ( $dbh->func($lobjId, 'lo_unlink') )
- and print "\$dbh->func(lo_unlink) ...... ok\n"
- or print "\$dbh->func(lo_unlink) ...... not ok\n";
-
--# compare large objects
--
- ( $pgin cmp $buf and $pgin cmp $blob )
- and print "compare blobs .............. not ok\n"
- or print "compare blobs .............. ok\n";
-
-+my $fd;
-+( $fd=$dbh->func( 'getfd') )
-+ and print "\$dbh->func(getfd) .......... ok\n"
-+ or print "\$dbh->func(getfd) .......... not ok\n";
-+
-+( $dbh->do( 'LISTEN test ') )
-+ and print "\$dbh->do('LISTEN test') .... ok\n"
-+ or print "\$dbh->do('LISTEN test') .... not ok\n";
-+
-+( $dbh1 = DBI->connect("$dsn_test", '', '', { AutoCommit => 1 }) )
-+ and print "DBI->connect (for notify)... ok\n"
-+ or die "DBI->connect (for notify)... not ok: ", $DBI::errstr;
-+
-+# there should be no data for read on $fd , until we send a notify
-+
-+ my $rout;
-+ my $rin = '';
-+ vec($rin,$fd,1) = 1;
-+ my $nfound = select( $rout=$rin, undef, undef, 0);
-+
-+( $nfound==0 )
-+ and print "select(\$fd) returns no data. ok\n"
-+ or die "select(\$fd) returns no data. not ok\n";
-+
-+( $dbh1->do( 'NOTIFY test ') )
-+ and print "\$dbh1->do('NOTIFY test') ... ok\n"
-+ or print "\$dbh1->do('NOTIFY test') ... not ok\n";
-+
-+ my $nfound = select( $rout=$rin, undef, undef, 1);
-+
-+( $nfound==1 )
-+ and print "select(\$fd) returns data.... ok\n"
-+ or die "select(\$fd) returns data.... not ok\n";
-+
-+my $notify_r;
-+
-+( $notify_r = $dbh->func('notifies') )
-+ and print "\$dbh->func('notifies')...... ok\n"
-+ or die "\$dbh->func('notifies')...... not ok\n";
-+
- ######################### disconnect and drop test database
-
- # disconnect
-@@ -462,6 +502,10 @@
- ( $dbh->disconnect )
- and print "\$dbh->disconnect ........... ok\n"
- or die "\$dbh->disconnect ........... not ok: ", $DBI::errstr;
-+
-+( $dbh1->disconnect )
-+ and print "\$dbh1->disconnect .......... ok\n"
-+ or die "\$dbh1->disconnect .......... not ok: ", $DBI::errstr;
-
- $dbh0->do("DROP DATABASE $dbtest");
- $dbh0->disconnect;
generated by cgit v1.2.1 (git 2.18.0) at 2025-08-12 12:31:50 +0000