head	1.5;
access;
symbols
	Version_2_1:1.2;
locks; strict;
comment	@% @;


1.5
date	93.06.14.19.47.35;	author aoki;	state Exp;
branches;
next	1.4;

1.4
date	93.02.16.22.50.06;	author aoki;	state Exp;
branches;
next	1.3;

1.3
date	92.02.15.20.33.20;	author mer;	state Exp;
branches;
next	1.2;

1.2
date	91.03.08.13.22.41;	author kemnitz;	state Exp;
branches;
next	1.1;

1.1
date	90.10.24.20.31.22;	author cimarron;	state Exp;
branches;
next	;


desc
@code contributed by Igor Metz
@


1.5
log
@added PQerrormsg to accessable globals
added PQexec error-handling

cleaned up Makefile to deal with Makefile.global hierarchy
(also proper dependencies)

bugfix for .mus file.. integer variables need to be cast to double
for str_numstr to understand them correctly.
@
text
@#!./pgperl
#
# $Header: /home2/aoki/postgres/src/contrib/pgperl/RCS/testlibpq.pl,v 1.4 1993/02/16 22:50:06 aoki Exp aoki $
#
# An example of how to use Postgres from perl.
# This example is modelled after the example in the libpq reference manual.

# Be certain you execute this from the contrib/pgperl directory of your
# Postgres distribution, and that the postgres ``bin'' directory
# is in your path.  Also, you *must* have the postmaster running!

$dbname = "pgperltest";
$pgdata = $ENV{'PGDATA'};

&init_handler();

# Destroy then create the database
# an error is ok in destroydb, since the database may not exist.
printf("Destroying database $dbname\n");
system("destroydb $dbname");
printf("Creating database $dbname\n");
if (system("createdb $dbname") / 256) {
    die("$0: createdb failed on $pgdata/$dbname\n");
}

# specify the database to access
&PQsetdb ($dbname);
$thedb = &PQdb();
printf("Accessing database $thedb\n");

printf("\nCreating relation person:\n");
&test_create();

printf("\nRelation person before appends:\n");
&test_functions();

printf("\nAppending to relation person:\n");
&test_append();

printf("\nRelation person after appends:\n");
&test_functions();

printf("\nTesting copy:\n");
&test_copy();

printf("\nRelation person after copy:\n");
&test_functions();

printf("\nTesting other things:\n");
&test_rest();

printf("\nRemoving from relation person:\n");
&test_remove();

printf("\nRelation person after removes:\n");
&test_functions();

printf("\nPrinting values of global variables:\n");
&test_vars();

printf("\nTests complete!\n");
# finish execution
&PQfinish ();

exit(0);

sub doPQexec {
    local($query) = @@_;
    local($result);

    $result = &PQexec($query);
    if ($result eq "R" || $result eq "E") {
	die("$0: doPQexec: the query\n\t$query\nproduced the error\n\t$PQerrormsg");
    }
}

sub test_create {
    local($query, $result);

    $query = "create person (name = char16, age = int4, location = point)";
    printf("query = %s\n", $query);
    &doPQexec($query);
}

sub test_append {
    local($i, $query);

    &doPQexec("begin"); # transaction
    for ($i=50; $i <= 150; $i = $i + 10) {
	$query = "append person (name = \"fred\", age = $i, location = \"($i,10)\"::point)";
	printf("query = %s\n", $query);
	&doPQexec($query);
    }
    &doPQexec("end"); # transaction
}

sub test_remove {
    local($i, $query);
    for ($i=50; $i <= 150; $i = $i + 10) {
	$query = "delete person where person.age = $i ";
	printf("query = %s\n", $query);
	&doPQexec($query);
    }
}

sub test_functions {
    local($p, $g, $t, $n, $m, $k, $i, $j);

    # fetch tuples from the person table
    &doPQexec ("begin");
    &doPQexec ("retrieve portal eportal (person.all)");
    &doPQexec ("fetch all in eportal");
    
    # examine all the tuples fetched
    $p = &PQparray ("eportal");	# remember: $p is a pointer !
    $g = &PQngroups ($p);
    $t = 0;

    for ($k=0; $k < $g; $k++) {
	printf("New tuple group:\n");
	$n = &PQntuplesGroup($p, $k);
	$m = &PQnfieldsGroup($p, $k);
	
	# print out the attribute names
	for ($i=0; $i < $m; $i++) {
	    printf("%-15s", &PQfnameGroup($p, $k, $i));
	}
	printf("\n");
	
	# print out the tuples
	for ($i=0; $i < $n; $i++) {
	    for ($j=0; $j < $m; $j++) {
		printf("%-15s", &PQgetvalue($p, $t + $i, $j));
	    }
	    printf("\n");
	}
	$t = $t + $n;
    }

    # close the portal
    &doPQexec ("close eportal");
    &doPQexec ("end");
    &PQclear("eportal");
}

sub test_vars {
    printf("PQhost = \"%s\"\n",		$PQhost);
    printf("PQport = \"%s\"\n",		$PQport);
    printf("PQtty = \"%s\"\n", 		$PQtty);
    printf("PQoption = \"%s\"\n",  	$PQoption);
    printf("PQdatabase = \"%s\"\n", 	$PQdatabase);
    printf("PQportset = %d\n", 		$PQportset);
    printf("PQxactid = %d\n",  		$PQxactid);
    printf("PQtracep = %d\n",  		$PQtracep);
    printf("PQerrormsg = \"%s\"\n",	$PQerrormsg);
}

sub test_copy {
    &doPQexec("copy person from stdin");
    &PQputline("bill	21	(1,2)\n");
    &PQputline("bob	61	(3,4)\n");
    &PQputline("sally	39	(5,6)\n");
    &PQputline(".\n");
    &PQendcopy();
}

sub test_rest {
    printf("Opening 2 portals:\n");
    &doPQexec ("begin");
    &doPQexec ("retrieve portal eportal (person.all)");
    &doPQexec ("fetch all in eportal");
    &doPQexec ("retrieve portal fportal (person.all)");
    &doPQexec ("fetch all in fportal");
    printf("Number of portals open: %d\n", &PQnportals(0));
    @@names = &PQpnames (0);
    print "Portal names: ", join(', ',@@names), ".\n";
    $p = &PQparray ("eportal");
    printf("Portal eportal %s asynchronous.\n",&PQrulep($p) ? "is" : "is not");
    printf("Portal eportal has %d tuples.\n",&PQntuples($p));
    printf("Portal eportal has %d instances.\n",&PQninstances($p));
    printf("Portal eportal has %d groups.\n",&PQngroups($p));
    printf("Portal eportal group 0 has %d instances.\n",&PQninstancesGroup($p,0));
    printf("Portal eportal tuple 0 has %d fields.\n",&PQnfields($p, 0));
    printf("Portal eportal tuple 0 field 2 is %d bytes long.\n",&PQgetlength($p, 0, 2));
    printf("Portal eportal tuple 0 field 2 is type %d.\n",&PQftype($p, 0, 2));
    printf("Portal eportal tuple 0 is in group %d.\n",&PQgetgroup($p, 0));
    printf("Portal eportal tuple 0 field \"location\" is index %d.\n",&PQfnumber($p, 0, "location"));
    printf("Portal eportal tuple 0 field 1 is name \"%s\".\n",&PQfname($p, 0, 1));
    printf("Portal eportal tuples 0 and 1 %s the same type.\n",&PQsametype($p, 0, 1) ? "are" : "are not");
    printf("Portal eportal group 0 field \"location\" is index %d.\n",&PQfnumberGroup($p, 0, "location"));
    printf("Closing 2 portals:\n");
    &doPQexec ("close eportal");
    &doPQexec ("close fportal");
    &doPQexec ("end");
    &PQclear("eportal");
    &PQclear("fportal");
    printf("Number of portals open: %d\n", &PQnportals(0));
    @@names = &PQpnames (0);
    print "Portal names: ", join(', ',@@names), ".\n";
}

sub init_handler {
    $SIG{'HUP'} = 'handler';
    $SIG{'INT'} = 'handler';
    $SIG{'QUIT'} = 'handler';
}

sub handler {  # 1st argument is signal name
    local($sig) = @@_;
    print "Caught a SIG$sig--shutting down connection to Postgres.\n";
    &PQfinish();
    exit(0);
}
@


1.4
log
@folded in RWW's changes and tested under ultrix
@
text
@d3 1
a3 1
# $Header$
d13 1
d18 7
a24 4

printf("Recreating database $dbname\n");
system("destroydb $dbname") if -e "../../../data/base/$dbname";
system("createdb $dbname");
d67 10
d78 1
a78 1
    local($query);
d82 1
a82 1
    &PQexec($query);
d88 1
a88 1
    &PQexec("begin"); # transaction
d92 1
a92 1
	&PQexec($query);
d94 1
a94 1
    &PQexec("end"); # transaction
d102 1
a102 1
	&PQexec($query);
d110 3
a112 3
    &PQexec ("begin");
    &PQexec ("retrieve portal eportal (person.all)");
    &PQexec ("fetch all in eportal");
d141 2
a142 2
    &PQexec ("close eportal");
    &PQexec ("end");
d147 9
a155 8
    printf("PQhost = %s\n", 	$PQhost);
    printf("PQport = %s\n",  	$PQport);
    printf("PQtty = %s\n",  	$PQtty);
    printf("PQoption = %s\n",  	$PQoption);
    printf("PQdatabase = %s\n", $PQdatabase);
    printf("PQportset = %d\n", 	$PQportset);
    printf("PQxactid = %d\n",  	$PQxactid);
    printf("PQtracep = %d\n",  	$PQtracep);
d159 1
a159 1
    &PQexec("copy person from stdin");
d169 5
a173 5
    &PQexec ("begin");
    &PQexec ("retrieve portal eportal (person.all)");
    &PQexec ("fetch all in eportal");
    &PQexec ("retrieve portal fportal (person.all)");
    &PQexec ("fetch all in fportal");
d192 3
a194 3
    &PQexec ("close eportal");
    &PQexec ("close fportal");
    &PQexec ("end");
@


1.3
log
@updated by George Hartzell of the Stanford Genome project
@
text
@a1 13
# An example of how to use Postgres 2.0 from perl.
# This example is modelled after the example in the libpq reference manual.
# $Id: testlibpq.pl,v 1.2 92/02/07 16:33:47 hartzell Exp $
# $Log:	testlibpq.pl,v $
#% Revision 1.2  92/02/07  16:33:47  hartzell
#% *** empty log message ***
#% 
#% Revision 1.1  92/01/29  15:10:42  hartzell
#% Initial revision
#% 
#% Revision 1.2  91/03/08  13:22:41  kemnitz
#% added RCS header.
#% 
d3 1
a3 2
# $Header: /genome/src/postgres/src/contrib/pgperl/RCS/testlibpq.pl,v 1.2 92/0
2/07 16:33:47 hartzell Exp $
d5 8
a12 3
#% Revision 1.1  90/10/24  20:31:22  cimarron
#% Initial revision
#% 
d16 6
d23 3
a25 1
&PQsetdb ("cimarron");
d27 1
a27 1
printf("creating relation person:\n\n");
d30 1
a30 1
printf("Relation person before appends:\n\n");
d32 2
d36 1
a36 1
printf("Relation person after appends:\n\n");
d38 11
a48 1
&PQreset (); # why do I have to reset the line ?? :-(
d51 1
a51 1
printf("Relation person after removes:\n\n");
d53 2
d57 1
d76 1
a76 2
	$query = "append person (name = \"fred\", age = $i, location = \"($i,10
)\"::point)";
d106 1
a106 1
	printf("\nNew tuple group:\n");
d125 1
a125 1
    
d129 1
a129 3

    # try some other functions
    printf("\nNumber of portals open: %d\n", &PQnportals(0));
a139 1
    printf("PQinitstr = %s\n", 	$PQinitstr);
d141 44
@


1.2
log
@added RCS header.
@
text
@d4 1
a4 1
# $Id: testlibpq.pl,v 1.1 90/10/24 20:31:22 cimarron Exp Locker: kemnitz $
d6 9
d16 2
a17 1
# $Header: RCS/README,v 1.1 90/10/24 20:23:49 cimarron Exp $
d19 3
a21 3
% Revision 1.1  90/10/24  20:31:22  cimarron
% Initial revision
% 
d62 2
a63 1
	$query = "append person (name = \"fred\", age = $i, location = \"($i,10)\"::point)";
d83 1
d115 2
a116 1
    
@


1.1
log
@Initial revision
@
text
@d4 1
a4 2

# $Id: testlibpq.pl,v 1.1 90/08/23 14:13:00 metz Exp $
d6 6
@