postgreslclient.p6

martin@meee:~/fakedbi$ cat postgresqlclient.p6
# postgresql test example 1 translated from C to Perl 6
# See http://www.postgresql.org/docs/9.0/static/libpq-example.html
# and more comments below.

use NativeCall;  # from project 'zavolaj'

# -------- foreign function definitions in alphabetical order ----------

sub PQclear( OpaquePointer $res )
    is native('libpq')
    { ... }

sub PQconnectdb( Str $conninfo )
    returns OpaquePointer
    is native('libpq')
    { ... }

sub PQerrorMessage( OpaquePointer $conn )
    returns Str
    is native('libpq')
    { ... }

sub PQexec( OpaquePointer $conn, Str $command )
    returns OpaquePointer
    is native('libpq')
    { ... }

sub PQfinish( OpaquePointer $conn )
    is native('libpq')
    { ... }

sub PQfname( OpaquePointer $res, Int $fieldnum )
    returns Str
    is native('libpq')
    { ... }

sub PQgetvalue( OpaquePointer $res, Int $tuplenum, Int $fieldnum )
    returns Str
    is native('libpq')
    { ... }

sub PQnfields( OpaquePointer $res )
    returns Int
    is native('libpq')
    { ... }

sub PQntuples( OpaquePointer $res )
    returns Int
    is native('libpq')
    { ... }

sub PQresultStatus( OpaquePointer $res )
    returns Int
    is native('libpq')
    { ... }

sub PQstatus( OpaquePointer $conn )
    returns Int
    is native('libpq')
    { ... }

 # from libpq-fe.h  These should of course be constants or perhaps even enums
sub CONNECTION_OK     { 0 }
sub CONNECTION_BAD    { 1 }

sub PGRES_EMPTY_QUERY { 0 }
sub PGRES_COMMAND_OK  { 1 }
sub PGRES_TUPLES_OK   { 2 }

sub exit_nicely(OpaquePointer $conn)
{
    PQfinish($conn);
    exit(1);
}

my $conninfo;
my $conn;
my $res;
my $nFields;
my $i,
my $j;

#
#   If the user supplies a parameter on the command line, use it as the
#   conninfo string; otherwise default to setting dbname=postgres and using
#   environment variables or defaults for all other connection parameters.
#
if ( @*ARGS.elems > 0 ) {
    $conninfo = @*ARGS[0];
}
else {
    $conninfo = "host=localhost user=testuser password=testpass dbname=zavolaj";
}

# Make a connection to the database
say "connecting";
$conn = PQconnectdb($conninfo);

# Check to see that the backend connection was successfully made
if (PQstatus($conn) != CONNECTION_OK)
{
    $*ERR.say: sprintf( "Connection to database failed: %s",
            PQerrorMessage($conn));
    exit_nicely($conn);
}

#
#   Our test case here involves using a cursor, for which we must be inside
#   a transaction block.  We could do the whole thing with a single
#   PQexec() of "select * from pg_database", but that's too trivial to make
#   a good example.
#

# Start a transaction block
$res = PQexec($conn, "BEGIN");

if (PQresultStatus($res) != PGRES_COMMAND_OK)
{
    $*ERR.say: sprintf("BEGIN command failed: %s", PQerrorMessage($conn));
    PQclear($res);
    exit_nicely($conn);
}

#
#   Should PQclear PGresult whenever it is no longer needed to avoid memory
#   leaks
#

PQclear($res);

#
# Fetch rows from pg_database, the system catalog of databases
#
$res = PQexec($conn, "DECLARE myportal CURSOR FOR select * from pg_database");
if (PQresultStatus($res) != PGRES_COMMAND_OK)
{
    $*ERR.say: sprintf("DECLARE CURSOR failed: %s", PQerrorMessage($conn));
    PQclear($res);
    exit_nicely($conn);
}
PQclear($res);

$res = PQexec($conn, "FETCH ALL in myportal");
if (PQresultStatus($res) != PGRES_TUPLES_OK)
{
    $*ERR.say: sprintf("FETCH ALL failed: %s", PQerrorMessage($conn));
    PQclear($res);
    exit_nicely($conn);
}

# first, print out the attribute names
$nFields = PQnfields($res);
loop ($i = 0; $i < $nFields; $i++) {
    printf("%-15s", PQfname($res, $i));
}
printf("\n\n");

# next, print out the rows
loop ($i = 0; $i < PQntuples($res); $i++)
{
    loop ($j = 0; $j < $nFields; $j++) {
        printf("%-15s", PQgetvalue($res, $i, $j));
    }
    printf("\n");
}

PQclear($res);

# close the portal ... we don't bother to check for errors ...
$res = PQexec($conn, "CLOSE myportal");
PQclear($res);

# end the transaction
$res = PQexec($conn, "END");
PQclear($res);

# close the connection to the database and cleanup
PQfinish($conn);

=begin pod

=head1 PREREQUISITES
Your system should already have libpq-dev installed.  Change to the
postgres user and connect to the postgres server as follows:

 sudo -U postgres psql

Then set up a test environment with the following:

 CREATE DATABASE zavolaj;
 CREATE ROLE testuser LOGIN PASSWORD 'testpass';
 GRANT ALL PRIVILEGES ON DATABASE zavolaj TO testuser;

The '\l' psql command output should include zavolaj as a database name.
Exit the psql client with a ^D, then try to use the new account:

 psql --host=localhost --dbname=zavolaj --username=testuser --password
 SELECT * FROM pg_database;

=end pod
martin@meee:~/fakedbi$ rakudo postgresqlclient.p6 
connecting
datname        datdba         encoding       datcollate     datctype       datistemplate  datallowconn   datconnlimit   datlastsysoid  datfrozenxid   dattablespace  datconfig      datacl         

template1      10             6              en_GB.UTF-8    en_GB.UTF-8    t              t              -1             11563          648            1663                          {=c/postgres,postgres=CTc/postgres}
template0      10             6              en_GB.UTF-8    en_GB.UTF-8    t              f              -1             11563          648            1663                          {=c/postgres,postgres=CTc/postgres}
postgres       10             6              en_GB.UTF-8    en_GB.UTF-8    f              t              -1             11563          648            1663                                         
test           10             6              en_GB.UTF-8    en_GB.UTF-8    f              t              -1             11563          648            1663                                         
zavolaj        10             6              en_GB.UTF-8    en_GB.UTF-8    f              t              -1             11563          648            1663                          {=Tc/postgres,postgres=CTc/postgres,testuser=CTc/postgres}