DBD::PrimeBase - PrimeBase database server driver for DBI

  use DBI;

  $dbh = DBI->connect('dbi:PrimeBase:Server=$SName;Address=$IPNUM;Database=$DBName', 'user', 'password');

  where:
    $SName is the PrimeBase server name, for example "PrimeServer". 
    $IPNUM is the IP address of the machine on which the PrimeBase server is running. Default "localhost"
    $DBName is the name of the database to be connected to.

# $Id: PrimeBase.pm,v 1.4001 2001/07/30 19:29:50
# Copyright (c) 2001  Snap Innovation
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
$DBD::PrimeBase::VERSION = '1.4003';

{
    package DBD::PrimeBase;

    use DBI ();
    use DynaLoader ();
    @ISA = qw(DynaLoader);

    my $Revision = substr(q$Revision: 1.00 $, 1);

    require_version DBI 1.02;

    bootstrap DBD::PrimeBase $VERSION;

    $err = 0;		# holds error code   for DBI::err    (XXX SHARED!)
    $errstr = "";	# holds error string for DBI::errstr (XXX SHARED!)
    $drh = undef;	# holds driver handle once initialised

    sub driver{
		return $drh if $drh;
		my($class, $attr) = @_;

		$class .= "::dr";

		# not a 'my' since we use it above to prevent multiple drivers

		$drh = DBI::_new_drh($class, {
		    'Name' => 'PrimeBase',
		    'Version' => $VERSION,
		    'Err'    => \$DBD::PrimeBase::err,
		    'Errstr' => \$DBD::PrimeBase::errstr,
		    'Attribution' => "DBD::PrimeBase $VERSION",
		    });

		$drh;
    }


    1;
}


{   package DBD::PrimeBase::dr; # ====== DRIVER ======
    use strict;


    sub connect {
		my ($drh, $dbname, $user, $auth, $attr)= @_;


		# create a 'blank' dbh

		my $dbh = DBI::_new_dbh($drh, {
		    'Name' => $dbname,
		    'USER' => $user, 'CURRENT_USER' => $user,
		    });

		DBD::PrimeBase::db::_login($dbh, $dbname, $user, $auth)
		    or return undef;


		$dbh;
    }

	sub admin {
	    my($drh) = shift;
	    my($command) = shift;
	    my($dbname) = ($command eq 'createdb'  ||  $command eq 'dropdb') ?
		shift : '';
	    my($host) = shift || '';
	    my($server) = shift || '';
	    my($user) = shift || '';
	    my($password) = shift || '';
	
	    	$drh->func(undef, $command,
				$dbname || '',
				$host || '',
				$server || '',
				$user, $password, '_admin_internal');
	}

}


{   package DBD::PrimeBase::db; # ====== DATABASE ======
    use strict;

  
	sub admin {
	    my($dbh) = shift;
	    my($command) = shift;
	    my($dbname) = ($command eq 'createdb'  ||  $command eq 'dropdb') ?
		shift : '';
	    $dbh->{'Driver'}->func($dbh, $command, $dbname, '', '', '',
				   '_admin_internal');
	}

  sub prepare {
		my($dbh, $statement, @attribs)= @_;

		# create a 'blank' dbh
		my $sth = DBI::_new_sth($dbh, {
		    'Statement' => $statement,
		    });

		# Call PrimeBase func in PrimeBase.xs file.
		# and populate internal handle data.

		DBD::PrimeBase::st::_prepare($sth, $statement, @attribs)
		    or return undef;

		$sth;
    }




    sub table_info {
		my($dbh) = @_;		# XXX add qualification

		# create a "blank" statement handle
		my $sth = DBI::_new_sth($dbh, { 'Statement' => "PBITables" });

		DBD::PrimeBase::st::_proc_call($sth, "table_info();")
			or return undef;
		$sth;
   }


    sub ping {
		my($dbh) = @_;
		my $ok = 0;
		local $SIG{__WARN__} = sub { } if $dbh->{PrintError};
		eval {
		    my $sth =  $dbh->prepare("describe databases");
		    # A describe databases should do the trick. 
		    $ok = $sth && $sth->execute;
		};
		return ($@) ? 0 : $ok;
    }

	
    sub type_info_all {
		my ($dbh) = @_;
		my $names = {
	          TYPE_NAME		=> 0,
	          DATA_TYPE		=> 1,
	          COLUMN_SIZE		=> 2,
	          LITERAL_PREFIX	=> 3,
	          LITERAL_SUFFIX	=> 4,
	          CREATE_PARAMS		=> 5,
	          NULLABLE		=> 6,
	          CASE_SENSITIVE	=> 7,
	          SEARCHABLE		=> 8,
	          UNSIGNED_ATTRIBUTE	=> 9,
	          FIXED_PREC_SCALE	=>10,
	          AUTO_UNIQUE_VALUE	=>11,
	          LOCAL_TYPE_NAME	=>12,
	          MINIMUM_SCALE		=>13,
	          MAXIMUM_SCALE		=>14,
	        };
		my $ti = [
		  $names,
	            [ 'VARCHAR', 12, 32000, '\'', '\'', 'max length', 1, 1, 3, undef, 0,undef, undef, undef, undef ],
				[ 'TIMESTAMP', 11, 22, undef, undef, undef, 1, 0, 2, undef, 0,undef, undef, 0, 2 ],
				[ 'TIME', 10, 8, undef, undef, undef, 1, 0, 2, undef, 0, undef,undef, undef, undef ],
				[ 'DATE', 9, 10, undef, undef, undef, 1, 0, 2, undef, 0, undef,undef, undef, undef ],
				[ 'DOUBLE', 8, 15, undef, undef, undef, 1, 0, 2, 0, 0, 0, undef,undef, undef ],
				[ 'REAL', 7, 7, undef, undef, undef, 1, 0, 2, 0, 0, 0, undef,undef, undef ],
				[ 'FLOAT', 6, 15, undef, undef, undef, 1, 0, 2, 0, 0, 0, undef,undef, undef ],
				[ 'SMINT', 5, 5, undef, undef, undef, 1, 0, 2, 0, 0, 0, undef,undef, undef ],
				[ 'INT', 4, 10, undef, undef, undef, 1, 0, 2, 0, 0, 0, undef,undef, undef ],
				[ 'DECIMAL', 3, 60, undef, undef, 'precision,scale', 1, 0, 2, 0, 0, 0,undef, 0, 60 ],
				[ 'CHAR', 1, 32000, '\'', '\'', 'max length', 1, 1, 3, undef, 0, undef,undef, undef, undef ],
				[ 'LONGCHAR', -1, undef, '\'', '\'', undef, 1, 0, 0, undef, 0, undef,undef, undef, undef ],
				[ 'BINARY', -2, 32000, '\'', '\'', 'max length', 1, 0, 2, undef, 0, undef,undef, undef, undef ],
				[ 'VARBIN', -3, 32000, '\'', '\'', 'max length', 1, 0, 2, undef, 0, undef,undef, undef, undef ],
				[ 'LONGBIN', -4, undef, '\'', '\'', undef, 1, 0, 0, undef, 0, undef,undef, undef, undef ],
				[ 'TINYINT', -6, 3, undef, undef, undef, 1, 0, 2, 1, 0, 0, undef,undef, undef ],
				[ 'BOOLEAN', -7, 1, undef, undef, undef, 1, 0, 2, undef, 0,undef, undef, undef, undef ],
	            [ 'WCHAR', -8, 32000, '\'', '\'', 'max length', 1, 1, 3, undef, 0,undef, undef, undef, undef ]
	        ];
	return $ti;
    }


}

{   package DBD::PrimeBase::st; # ====== STATEMENT ======

    # all done in XS
}


1;
__END__