install/5.005/DBD-Pg-1.22-fixvercmp/eg/lotest.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 use DBI;
   6 use DBD::Pg;
   7
   8 my $dsn = "dbname=p1";
   9 my $dbh = DBI->connect('dbi:Pg:dbname=p1', undef, undef, { AutoCommit => 1 });
  10
  11 my $buf = 'abcdefghijklmnopqrstuvwxyz' x 400;
  12
  13 my $id = write_blob($dbh, undef, $buf);
  14
  15 my $dat = read_blob($dbh, $id);
  16
  17 print "Done\n";
  18
  19 sub write_blob {
  20     my ($dbh, $lobj_id, $data) = @_;
  21
  22     # begin transaction
  23     $dbh->{AutoCommit} = 0;
  24
  25     # Create a new lo if we are not passed an lo object ID.
  26     unless ($lobj_id) {
  27         # Create the object.
  28         $lobj_id = $dbh->func($dbh->{'pg_INV_WRITE'}, 'lo_creat');
  29     }
  30
  31     # Open it to get a file descriptor.
  32     my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_WRITE'}, 'lo_open');
  33
  34     $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
  35
  36     # Write some data to it.
  37     my $len = $dbh->func($lobj_fd, $data, length($data), 'lo_write');
  38
  39     die "Errors writing lo\n" if $len != length($data);
  40
  41     # Close 'er up.
  42     $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
  43
  44     # end transaction
  45     $dbh->{AutoCommit} = 1;
  46
  47     return $lobj_id;
  48 }
  49
  50 sub read_blob {
  51     my ($dbh, $lobj_id) = @_;
  52     my $data = '';
  53     my $read_len = 256;
  54     my $chunk = '';
  55
  56     # begin transaction
  57     $dbh->{AutoCommit} = 0;
  58
  59     my $lobj_fd = $dbh->func($lobj_id, $dbh->{'pg_INV_READ'}, 'lo_open');
  60
  61     $dbh->func($lobj_fd, 0, 0, 'lo_lseek');
  62
  63     # Pull out all the data.
  64     while ($dbh->func($lobj_fd, $chunk, $read_len, 'lo_read')) {
  65         $data .= $chunk;
  66     }
  67
  68     $dbh->func($lobj_fd, 'lo_close') or die "Problems closing lo object\n";
  69
  70     # end transaction
  71     $dbh->{AutoCommit} = 1;
  72
  73     return $data;
  74 }