# create large object from binary file

my ($ascii, $pgin); foreach $ascii (0..255) { $pgin .= chr($ascii); };

my $PGIN = '/tmp/pgin'; open(PGIN, ">$PGIN") or die "can not open $PGIN"; print PGIN $pgin; close PGIN;

# begin transaction $dbh->{AutoCommit} = 0;

my $lobjId; ( $lobjId = $dbh->func($PGIN, 'lo_import') ) and print "\$dbh->func(lo_import) ...... ok\n" or print "\$dbh->func(lo_import) ...... not ok\n";

# end transaction $dbh->{AutoCommit} = 1;

unlink $PGIN;

# blob_read

# begin transaction $dbh->{AutoCommit} = 0;

$sth = $dbh->prepare( "" ) or die $DBI::errstr;

my $blob; ( $blob = $sth->blob_read($lobjId, 0, 0) ) and print "\$sth->blob_read ............ ok\n" or print "\$sth->blob_read ............ not ok\n";

$sth->finish or die $DBI::errstr;

# end transaction $dbh->{AutoCommit} = 1;

# read large object using lo-functions

# begin transaction $dbh->{AutoCommit} = 0;

my $lobj_fd; # may be 0 ( defined($lobj_fd = $dbh->func($lobjId, $dbh->{pg_INV_READ}, 'lo_open')) ) and print "\$dbh->func(lo_open) ........ ok\n" or print "\$dbh->func(lo_open) ........ not ok\n";

( 0 == $dbh->func($lobj_fd, 0, 0, 'lo_lseek') ) and print "\$dbh->func(lo_lseek) ....... ok\n" or print "\$dbh->func(lo_lseek) ....... not ok\n";

my $buf = ''; ( 256 == $dbh->func($lobj_fd, $buf, 256, 'lo_read') ) and print "\$dbh->func(lo_read) ........ ok\n" or print "\$dbh->func(lo_read) ........ not ok\n";

( 256 == $dbh->func($lobj_fd, 'lo_tell') ) and print "\$dbh->func(lo_tell) ........ ok\n" or print "\$dbh->func(lo_tell) ........ not ok\n";

( $dbh->func($lobj_fd, 'lo_close') ) and print "\$dbh->func(lo_close) ....... ok\n" or print "\$dbh->func(lo_close) ....... not ok\n";

( $dbh->func($lobjId, 'lo_unlink') ) and print "\$dbh->func(lo_unlink) ...... ok\n" or print "\$dbh->func(lo_unlink) ...... not ok\n";

# end transaction $dbh->{AutoCommit} = 1;

# compare large objects

( $pgin cmp $buf and $pgin cmp $blob ) and print "compare blobs .............. not ok\n" or print "compare blobs .............. ok\n";

######################### disconnect and drop test database

# disconnect

( $dbh->disconnect ) and print "\$dbh->disconnect ........... ok\n" or die "\$dbh->disconnect ........... not ok: ", $DBI::errstr;

$dbh0->do("DROP DATABASE $dbtest"); $dbh0->disconnect;

print "test sequence finished.\n";

######################### EOF # the actual test script is here

cpanm DBD::PgSPI

perl -MCPAN -e shell
install DBD::PgSPI