0 # l=JJj"TZţ h 1 ; l4(&T qTţ  ?a=JJj"Tƙţ0} { package DBD::ExampleP; use strict; use Symbol; use DBI qw(:sql_types); require File::Spec; our (@EXPORT,$VERSION,@statnames,%statnames,@stattypes,%stattypes, @statprec,%statprec,$drh,); @EXPORT = qw(); # Do NOT @EXPORT anything. $VERSION = "12.014311"; # $Id: ExampleP.pm 14310 2010-08-02 06:35:25Z Jens $ # # Copyright (c) 1994,1997,1998 Tim Bunce # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. @statnames = qw(dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks name); @statnames{@statnames} = (0 .. @statnames-1); @stattypes = (SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_VARCHAR); @stattypes{@statnames} = @stattypes; @statprec = ((10) x (@statnames-1), 1024); @statprec{@statnames} = @statprec; die unless @statnames == @stattypes; die unless @statprec == @stattypes; $drh = undef; # holds driver handle once initialised #$gensym = "SYM000"; # used by st::execute() for filehandles sub driver{ return $drh if $drh; my($class, $attr) = @_; $class .= "::dr"; ($drh) = DBI::_new_drh($class, { 'Name' => 'ExampleP', 'Version' => $VERSION, 'Attribution' => 'DBD Example Perl stub by Tim Bunce', }, ['example implementors private data '.__PACKAGE__]); $drh; } sub CLONE { undef $drh; } } { package DBD::ExampleP::dr; # ====== DRIVER ====== $imp_data_size = 0; use strict; sub connect { # normally overridden, but a handy default my($drh, $dbname, $user, $auth)= @_; my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dbname, examplep_private_dbh_attrib => 42, # an example, for testing }); $dbh->{examplep_get_info} = { 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR 41 => '.', # SQL_CATALOG_NAME_SEPARATOR 114 => 1, # SQL_CATALOG_LOCATION }; #$dbh->{Name} = $dbname; $dbh->STORE('Active', 1); return $outer; } sub data_sources { return ("dbi:ExampleP:dir=."); # possibly usefully meaningless } } { package DBD::ExampleP::db; # ====== DATABASE ====== $imp_data_size = 0; use strict; sub prepare { my($dbh, $statement)= @_; my @fields; my($fields, $dir) = $statement =~ m/^\s*select\s+(.*?)\s+from\s+(\S*)/i; if (defined $fields and defined $dir) { @fields = ($fields eq '*') ? keys %DBD::ExampleP::statnames : split(/\s*,\s*/, $fields); } else { return $dbh->set_err($DBI::stderr, "Syntax error in select statement (\"$statement\")") unless $statement =~ m/^\s*set\s+/; # the SET syntax is just a hack so the ExampleP driver can # be used to test non-select statements. # Now we have DBI::DBM etc., ExampleP should be deprecated } my ($outer, $sth) = DBI::_new_sth($dbh, { 'Statement' => $statement, examplep_private_sth_attrib => 24, # an example, for testing }, ['example implementors private data '.__PACKAGE__]); my @bad = map { defined $DBD::ExampleP::statnames{$_} ? () : $_ } @fields; return $dbh->set_err($DBI::stderr, "Unknown field names: @bad") if @bad; $outer->STORE('NUM_OF_FIELDS' => scalar(@fields)); $sth->{examplep_ex_dir} = $dir if defined($dir) && $dir !~ /\?/; $outer->STORE('NUM_OF_PARAMS' => ($dir) ? $dir =~ tr/?/?/ : 0); if (@fields) { $outer->STORE('NAME' => \@fields); $outer->STORE('NULLABLE' => [ (0) x @fields ]); $outer->STORE('SCALE' => [ (0) x @fields ]); } $outer; } sub table_info { my $dbh = shift; my ($catalog, $schema, $table, $type) = @_; my @types = split(/["']*,["']/, $type || 'TABLE'); my %types = map { $_=>$_ } @types; # Return a lis