view release on metacpan or search on metacpan
lib/Cyrillic.pm view on Meta::CPAN
# P.331 Inlining Constant Functions
# in Chapter 7: Subroutines
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition.
sub LOCK_SH() {1}
sub LOCK_EX() {2}
sub LOCK_UN() {8}
sub LOCK_NB() {4}
sub unimport {}
sub Cyrillic::escape_script;
# 6.18. Matching Multiple-Byte Characters
view all matches for this distribution
view release on metacpan or search on metacpan
sub commit ($);
sub release ($);
sub drop ($);
sub next ($%);
sub attributes_number ($);
sub values_number($%);
sub value_length ($%);
sub delete ($%);
sub extract ($%);
sub insert ($%);
sub replace ($%);
}
##
# Number of values
#
sub values_number($%)
{ my $self=shift;
my $args=get_args(\@_);
my $attr=$args->{attribute} || $args->{attr} || 0;
ag_db_stat($$self,$attr,-1);
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/DB/Object.pm view on Meta::CPAN
sub auto_convert_datetime_to_object { return( shift->_set_get_scalar( 'auto_convert_datetime_to_object', @_ ) ); }
sub auto_decode_json { return( shift->_set_get_scalar( 'auto_decode_json', @_ ) ); }
sub attribute($;$@)
{
my $self = shift( @_ );
# $h->{AttributeName} = ...; # set/write
# ... = $h->{AttributeName}; # get/read
# 1 means that the attribute may be modified
lib/DB/Object.pm view on Meta::CPAN
}
}
}
}
sub available_drivers(@)
{
my $self = shift( @_ );
my $class = ref( $self ) || $self;
# @ary = DBI->available_drivers( $quiet );
return( $class->SUPER::available_drivers( 1 ) );
lib/DB/Object.pm view on Meta::CPAN
sub cache_table { return( shift->_set_get_boolean( 'cache_table', @_ ) ); }
sub cache_tables { return( shift->_set_get_object( 'cache_tables', 'DB::Object::Cache::Tables', @_ ) ); }
sub check_driver()
{
my $self = shift( @_ );
my $driver = shift( @_ ) || return( $self->error( "No SQL driver provided to check" ) );
my $ok = undef();
local $_;
lib/DB/Object.pm view on Meta::CPAN
sub create_db { return( shift->error( "The driver has not implemented the create database method create_db." ) ); }
sub create_table { return( shift->error( "The driver has not implemented the create table method create_table." ) ); }
sub data_sources($;\%)
{
my $self = shift( @_ );
my $class = ref( $self ) || $self;
my $opt;
$opt = shift( @_ ) if( @_ );
lib/DB/Object.pm view on Meta::CPAN
my $dict = $self->datatype_dict || return( $self->pass_error );
my $ref = +{ map{ $_ => $dict->{ $_ }->{constant} } keys( %$dict ) };
return( $ref );
}
sub disconnect($)
{
my $self = shift( @_ );
# my( $pack, $file, $line ) = caller();
# print( STDERR "disconnect() called from package '$pack' in file '$file' at line '$line'.\n" );
my $rc = $self->{dbh}->disconnect( @_ );
return( $rc );
}
sub do($;$@)
{
my $self = shift( @_ );
# $rc = $dbh->do( $statement ) || die( $dbh->errstr );
# $rc = $dbh->do( $statement, \%attr ) || die( $dbh->errstr );
# $rv = $dbh->do( $statement, \%attr, @bind_values ) || ...
lib/DB/Object.pm view on Meta::CPAN
my $prev = $self->{enhance};
$self->{enhance} = shift( @_ ) if( @_ );
return( $prev );
}
sub err(@)
{
my $self = shift( @_ );
# $rv = $h->err;
if( defined( $self->{sth} ) )
{
lib/DB/Object.pm view on Meta::CPAN
sub errmesg
{
goto( &errstr );
}
sub errstr(@)
{
my $self = shift( @_ );
if( !ref( $self ) )
{
return( $DBI::errstr || $DB_ERRSTR );
lib/DB/Object.pm view on Meta::CPAN
}
}
sub passwd { return( shift->_set_get_scalar( 'passwd', @_ ) ); }
sub ping(@)
{
#return( shift->{ 'dbh' }->ping );
my $self = shift( @_ );
return( $self->{dbh}->ping );
}
sub ping_select(@)
{
my $self = shift( @_ );
# $rc = $dbh->ping;
# Some new ping method replacement.... See Apache::DBI
# my( $dbh ) = @_;
lib/DB/Object.pm view on Meta::CPAN
}
sub port { return( shift->_set_get_number( 'port', @_ ) ); }
# Gateway to DB::Object::Statement
sub prepare($;$)
{
my $self = shift( @_ );
my $class = ref( $self ) || $self;
my $query = shift( @_ );
my $opt_ref = shift( @_ ) || undef();
lib/DB/Object.pm view on Meta::CPAN
$self->{query} = $query;
return( $self->error( $err ) );
}
}
sub query($$)
{
my $self = shift( @_ );
my $sth = $self->prepare( @_ );
my $result;
if( $sth && !( $result = $sth->execute() ) )
lib/DB/Object.pm view on Meta::CPAN
return( wantarray() ? () : undef() ) if( !%$ref );
return( wantarray() ? %$ref : $ref );
}
}
sub state(@)
{
my $self = shift( @_ );
# $str = $h->state;
if( !ref( $self ) )
{
view all matches for this distribution
view release on metacpan or search on metacpan
t/transaction.t view on Meta::CPAN
}
}
my $stub_dbh = stub::db->new;
sub my_try(&) {
my $code = shift;
my $error = do {
local $@;
eval {
$code->();
view all matches for this distribution
view release on metacpan or search on metacpan
t/10dsnlist.t view on Meta::CPAN
print "1..0\n";
exit 0;
}
if ($verbose) { print "Driver is $mdriver\n"; }
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
view all matches for this distribution
view release on metacpan or search on metacpan
lib/DBD/AnyData2.pm view on Meta::CPAN
@DBD::AnyData2::AdvancedChangingTable::ISA = qw(DBD::AnyData2::Table);
use Carp qw/croak/;
sub capability($)
{
my ( $self, $capname ) = @_;
exists $self->{capabilities}->{$capname} and return $self->{capabilities}->{$capname};
my $meta = $self->{meta};
view all matches for this distribution
view release on metacpan or search on metacpan
t/40blobs.t view on Meta::CPAN
use DBI;
use tests;
print "1..$tests\n";
sub ShowBlob($) {
my ($blob) = @_;
for($i = 0; $i < 8; $i++) {
if (defined($blob) && length($blob) > $i) {
$b = substr($blob, $i*32);
} else {
view all matches for this distribution
view release on metacpan or search on metacpan
#
# Various
#
sub DTF_FALSE() { 0 }
sub DTF_TRUE() { 1 }
# NULL or not
sub NULL() { 0 }
sub not_NULL() { 1 }
# NULL handle
sub DTFHANDLE_NULL() { 0 }
#---------------------------------------------------------------------------------------------------------
#
# Some Dimension Constants
#
# max length for column and table names (incl. \0)
sub DTF_MAX_NAME() { 25 }
# max length of user name or password (incl. \0)
sub DTF_MAX_USERPASS() { 17 }
# min and max database file size, in KBytes
sub DTF_MIN_MAXSIZE() { 0x00000800 } # ...KB == 2MB
sub DTF_MAX_MAXSIZE() { 0x001fe000 } # ...KB == 2GB
# max non-blob fieldlength
sub DTF_MAX_FIELDLENGTH() { 4096 }
#---------------------------------------------------------------------------------------------------------
#
# Result Type of curser
#
sub DTF_RT_SEQUENTIAL() { 0 }
sub DTF_RT_RANDOM() { 1 }
#---------------------------------------------------------------------------------------------------------
#
# Connection Flags
#
sub DTF_CF_FILENAME() { 0 } # if set, file name (string)
sub DTF_CF_NETWORK() { 1 } # if set, network connection (string)
sub DTF_CF_FSSPEC() { 2 } # if set, filename Mac OS FSSpec record in FSSpec fmt.
#---------------------------------------------------------------------------------------------------------
#
# Error/Result Codes
#
sub DTF_ERR_OK() { 0 }
sub DTF_ERR_BAD() { 1 }
sub DTF_ERR_FATAL() { 2 }
sub DTF_ERR_OTHER() { 3 }
sub DTF_ERR_BAD_ID() { 4 }
sub DTF_ERR_LOCK() { 5 }
sub DTF_ERR_NO_SEG() { 6 }
sub DTF_ERR_NO_PAGE() { 7 }
sub DTF_ERR_NO_BUFFER() { 8 }
sub DTF_ERR_IO() { 9 }
sub DTF_ERR_FULL() { 10 }
sub DTF_ERR_NO_FILE() { 11 }
sub DTF_ERR_RANGE() { 12 }
sub DTF_ERR_FILE() { 13 }
sub DTF_ERR_MEMORY() { 14 }
sub DTF_ERR_INTEGRITY() { 15 }
sub DTF_ERR_NO_SCAN() { 16 }
sub DTF_ERR_NO_MORE_RECORDS() { 17 }
sub DTF_ERR_BUFFER_FULL() { 18 }
sub DTF_ERR_EXISTS() { 19 }
sub DTF_ERR_DOES_NOT_EXIST() { 20 }
sub DTF_ERR_SERVER() { 21 }
sub DTF_ERR_CLIENT() { 22 }
sub DTF_ERR_SYNC() { 23 }
sub DTF_ERR_NET() { 24 }
sub DTF_ERR_STOPPED() { 25 }
sub DTF_ERR_PASSWORD() { 26 }
sub DTF_ERR_ACCESS() { 27 }
sub DTF_ERR_DIV_BY_ZERO() { 28 }
sub DTF_ERR_CONVERSION() { 29 }
sub DTF_ERR_RESOURCE() { 30 }
sub DTF_ERR_TM_FULL() { 31 }
sub DTF_ERR_VERSION() { 32 }
sub DTF_ERR_LOG_READY() { 33 }
sub DTF_ERR_SEQUENCE() { 34 }
# first user error
sub DTF_ERR_USER() { 64 }
# result class
sub DTF_RC_OTHER() { 0 }
sub DTF_RC_RESULT_AVAILABLE() { 1 }
sub DTF_RC_ROWS_AFFECTED() { 2 }
#---------------------------------------------------------------------------------------------------------
#
# ATTRIBUTES
#---------------------------------------------------------------------------------------------------------
# Attribute Types
sub DTF_ATY_LONG() { 0 }
sub DTF_ATY_STRING() { 1 }
sub DTF_ATY_ENUM() { 2 }
#---------------------------------------------------------------------------------------------------------
# Attribute ID convention:
# L .. column attribute
#
#---------------------------------------------------------------------------------------------------------
# 'invalid' attribute
sub DTF_AT_NONE() { _define_Attribut(ord("\0"), ord("\0"), ord("\0"), ord("\0")) }
#---------------------------------------------------------------------------------------------------------
# global scope attributes
sub DTF_AT_CODEPAGE() { _define_Attribut(ord("H"), ord("C"), ord("P"), ord("g")) }
#---------------------------------------------------------------------------------------------------------
# environment scope attributes
sub DTF_EAT_MESSAGEFILE() { _define_Attribut(ord("E"), ord("M"), ord("s"), ord("F")) }
sub DTF_EAT_RESULTS() { _define_Attribut(ord("E"), ord("R"), ord("e"), ord("s")) }
sub DTF_EAT_RESULTPAGES() { _define_Attribut(ord("E"), ord("R"), ord("e"), ord("P")) }
sub DTF_EAT_LOGLEVEL() { _define_Attribut(ord("E"), ord("L"), ord("L"), ord("v")) }
sub DTF_EAT_LOGFILE() { _define_Attribut(ord("E"), ord("L"), ord("F"), ord("l")) }
sub DTF_EAT_XSFILES() { _define_Attribut(ord("E"), ord("X"), ord("F"), ord("s")) }
sub DTF_EAT_VMTYPE() { _define_Attribut(ord("E"), ord("V"), ord("T"), ord("y")) }
sub DTF_EAT_VMPATH() { _define_Attribut(ord("E"), ord("V"), ord("P"), ord("t")) }
sub DTF_EAT_VMSLOTS() { _define_Attribut(ord("E"), ord("V"), ord("S"), ord("l")) }
sub DTF_EAT_VMFILESLOTS() { _define_Attribut(ord("E"), ord("V"), ord("F"), ord("S")) }
sub DTF_EAT_VMFREEMEM() { _define_Attribut(ord("E"), ord("V"), ord("F"), ord("M")) }
#---------------------------------------------------------------------------------------------------------
# connection scope attributes
sub DTF_CAT_TIMEOUT() { _define_Attribut(ord("C"), ord("T"), ord("i"), ord("O")) }
sub DTF_CAT_RESETADAPTER() { _define_Attribut(ord("C"), ord("R"), ord("A"), ord("d")) }
sub DTF_CAT_REMOVENETNAME() { _define_Attribut(ord("C"), ord("R"), ord("N"), ord("N")) }
sub DTF_CAT_NETSYNCDELAY() { _define_Attribut(ord("C"), ord("N"), ord("S"), ord("D")) }
sub DTF_CAT_TRANSACTIONS() { _define_Attribut(ord("C"), ord("T"), ord("r"), ord("a")) }
sub DTF_CAT_CACHEBUFFERS() { _define_Attribut(ord("C"), ord("B"), ord("u"), ord("f")) }
sub DTF_CAT_PAGEALGO() { _define_Attribut(ord("C"), ord("P"), ord("A"), ord("l")) }
sub DTF_CAT_R4MODE() { _define_Attribut(ord("C"), ord("4"), ord("M"), ord("d")) }
sub DTF_CAT_R4STATE() { _define_Attribut(ord("C"), ord("4"), ord("S"), ord("t")) }
sub DTF_CAT_R4PATH() { _define_Attribut(ord("C"), ord("4"), ord("P"), ord("t")) }
sub DTF_CAT_R4BACKUPPATH() { _define_Attribut(ord("C"), ord("4"), ord("B"), ord("P")) }
sub DTF_CAT_R4LOGFILESIZE() { _define_Attribut(ord("C"), ord("4"), ord("L"), ord("S")) }
sub DTF_CAT_DBTYPE() { _define_Attribut(ord("C"), ord("D"), ord("b"), ord("T")) }
sub DTF_CAT_DBCREATOR() { _define_Attribut(ord("C"), ord("D"), ord("b"), ord("C")) }
sub DTF_CAT_SRVSETUP() { _define_Attribut(ord("C"), ord("S"), ord("s"), ord("t")) }
sub DTF_CAT_AUTORECOVER() { _define_Attribut(ord("C"), ord("A"), ord("R"), ord("c")) }
#---------------------------------------------------------------------------------------------------------
# transaction scope attributes
sub DTF_TAT_AUTOCOMMIT() { _define_Attribut(ord("T"), ord("A"), ord("C"), ord("m")) }
sub DTF_TAT_RESULTTYPE() { _define_Attribut(ord("T"), ord("R"), ord("T"), ord("y")) }
#---------------------------------------------------------------------------------------------------------
# result scope attributes
sub DTF_RAT_TYPE() { _define_Attribut(ord("R"), ord("T"), ord("y"), ord("p")) }
#---------------------------------------------------------------------------------------------------------
# column scope attributes
sub DTF_LAT_NAME() { _define_Attribut(ord("L"), ord("N"), ord("a"), ord("m")) }
sub DTF_LAT_TABLENAME() { _define_Attribut(ord("L"), ord("T"), ord("N"), ord("m")) }
sub DTF_LAT_CTYPE() { _define_Attribut(ord("L"), ord("C"), ord("T"), ord("y")) }
sub DTF_LAT_DEFINITION() { _define_Attribut(ord("L"), ord("D"), ord("e"), ord("f")) }
sub DTF_LAT_SIZE() { _define_Attribut(ord("L"), ord("S"), ord("i"), ord("z")) }
sub DTF_LAT_DISPLAYWIDTH() { _define_Attribut(ord("L"), ord("D"), ord("W"), ord("d")) }
sub DTF_LAT_PRECISION() { _define_Attribut(ord("L"), ord("P"), ord("r"), ord("c")) }
sub DTF_LAT_SCALE() { _define_Attribut(ord("L"), ord("S"), ord("c"), ord("l")) }
#---------------------------------------------------------------------------------------------------------
#
# C data type IDs
#
sub DTF_CT_DEFAULT() { 0 } # dtF/SQL datatype
sub DTF_CT_CHAR() { 1 } # char
sub DTF_CT_UCHAR() { 2 } # unsigned char
sub DTF_CT_SHORT() { 3 } # short
sub DTF_CT_USHORT() { 4 } # unsigned short
sub DTF_CT_LONG() { 5 } # long
sub DTF_CT_ULONG() { 6 } # unsigned long
sub DTF_CT_BOOL() { 7 } # DTFBOOL
sub DTF_CT_DOUBLE() { 8 } # double
sub DTF_CT_CSTRING() { 9 } # null-terminated character string
sub DTF_CT_SQLSTRING() { 10 } # like CSTRING but quoted if necessary
sub DTF_CT_BLOB() { 11 } # array of char
sub DTF_CT_DATE() { 13 } # DTFDATE yyyy-mm-dd\0
sub DTF_CT_TIME() { 14 } # DTFTIME hh:mm:ss\0
sub DTF_CT_TIMESTAMP() { 15 } # DTFTIMESTAMP yyyy-mm-dd hh:mm:ss\0
sub DTF_CT_DECIMAL() { 16 } # DTFDECIMAL
sub DTF_CT_COUNT() { 17 } # (number of DTFCTYPE enum values)
#---------------------------------------------------------------------------------------------------------
#
# dtF/SQL data type IDs
#
sub DTF_DT_NULL() { 0 }
sub DTF_DT_BYTE() { 1 }
sub DTF_DT_WORD() { 2 }
sub DTF_DT_LONGWORD() { 3 }
sub DTF_DT_CHAR() { 4 }
sub DTF_DT_SHORT() { 5 }
sub DTF_DT_LONG() { 6 }
sub DTF_DT_REAL() { 7 }
sub DTF_DT_DECIMAL() { 8 } # total max 16 digits [xxxx xxxx xxxx . xxxx = (16, 4) ]
# min 1 digit ahead of dec. point, 0 fraction digits allowd
sub DTF_DT_SHORTSTRING() { 9 }
sub DTF_DT_BIT() { 10 }
sub DTF_DT_DATE() { 11 } # yyyy-mm-dd
sub DTF_DT_TIME() { 12 } # hh:mm:ss
sub DTF_DT_TIMESTAMP() { 14 } # yyyy-mm-dd hh:mm:ss
sub DTF_DT_COUNT() { 15 }
#---------------------------------------------------------------------------------------------------------
#
# ???
#
sub DTF_INVALID_COUNT() { hex('0xffffffff') }
#---------------------------------------------------------------------------------------------------------
#
# AUTO COMMIT ON / OFF
#
# (example: DtfHdlSetAttribute ($htra, DTF_TAT_AUTOCOMMIT, AUTO_COMMIT_ON); )
sub AUTO_COMMIT_ON() { 'true' }
sub AUTO_COMMIT_OFF() { 'false' }
#---------------------------------------------------------------------------------------------------------
#
# MODULE FUNCTIONS
view all matches for this distribution
view release on metacpan or search on metacpan
lib/DBD/Excel.pm view on Meta::CPAN
#-------------------------------------------------------------------------------
# connect (DBD::Excel::dr)
# connect database(ie. parse specified Excel file)
#-------------------------------------------------------------------------------
sub connect($$@) {
my($hDr, $sDbName, $sUsr, $sAuth, $rhAttr)= @_;
#1. create database-handle
my $hDb = DBI::_new_dbh($hDr, {
Name => $sDbName,
USER => $sUsr,
lib/DBD/Excel.pm view on Meta::CPAN
}
#-------------------------------------------------------------------------------
# _getColName (DBD::Excel::dr)
# internal use
#-------------------------------------------------------------------------------
sub _getColName($$$$$$) {
my($iIgnore, $iHidden, $oWkS, $iRow, $iColS, $iColCnt) = @_;
my $iColMax; #MAXIAM Range of Columns (Contains HIDDEN Columns)
my $iCntWk = 0;
my $MaxCol = defined ($oWkS->{MaxCol}) ? $oWkS->{MaxCol} : 0;
lib/DBD/Excel.pm view on Meta::CPAN
@DBD::Excel::Table::ISA = qw(SQL::Eval::Table);
#-------------------------------------------------------------------------------
# column_num (DBD::Excel::Statement)
# Called with "SELECT ... FETCH"
#-------------------------------------------------------------------------------
sub column_num($$) {
my($oThis, $sCol) =@_;
$sCol = uc($sCol) if($oThis->{xl_t_database}->FETCH('xl_ignorecase'));
return $oThis->SUPER::column_num($sCol);
}
#-------------------------------------------------------------------------------
# column(DBD::Excel::Statement)
# Called with "SELECT ... FETCH"
#-------------------------------------------------------------------------------
sub column($$;$) {
my($oThis, $sCol, $sVal) =@_;
$sCol = uc($sCol) if($oThis->{xl_t_database}->FETCH('xl_ignorecase'));
if(defined $sVal) {
return $oThis->SUPER::column($sCol, $sVal);
}
view all matches for this distribution
view release on metacpan or search on metacpan
Firebird.pm view on Meta::CPAN
'Attribution' => 'DBD::Firebird by Edwin Pratomo and Daniel Ritz'});
$drh;
}
# taken from JWIED's DBD::mysql, with slight modification
sub _OdbcParse($$$)
{
my($class, $dsn, $hash, $args) = @_;
my($var, $val);
if (!defined($dsn))
view all matches for this distribution
view release on metacpan or search on metacpan
t/10dsnlist.t view on Meta::CPAN
print "1..0\n";
exit 0;
}
if ($verbose) { print "Driver is $mdriver\n"; }
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
view all matches for this distribution
view release on metacpan or search on metacpan
examples/fetchscroll.pl view on Meta::CPAN
use DBI;
use Carp;
my $debug = 0;
sub fetchrow_scroll_arrayref($$$$)
{
my($sth, $ctl, $key, $val) = @_;
my($cur, $max, $done, $aref) = ($$ctl{currow}, $$ctl{maxrow}, $$ctl{finished}, $$ctl{array});
my(@arr) = @$aref;
my($inc, $abs) = (0, $cur);
examples/fetchscroll.pl view on Meta::CPAN
my @data = sort "systables", "syscolumns", "sysindexes", "sysconstraints", "syschecks", "syscolauth",
"systabauth", "syssynonyms", "sysdefaults", "sysprocedures", "sysprocauth", "sysviews",
"sysroles", "sysroleauth", "sysusers", "systriggers", "sysprocbody", "systrigbody",
"sysxtdtypes", "sysxtdtypeauth", "sysxtddesc", "sysreferences", "syscoldepends", "sysdepends";
sub test_scroll_query_sequence($%)
{
my ($sth, %ops) = @_;
my $ctl = { array => [ undef ], maxrow => 0, currow => 0, finished => 0 };
my $i = 0;
my $fail = 0;
view all matches for this distribution
view release on metacpan or search on metacpan
}
$dbname = "dbi:Ingres:$dbname" unless $dbname =~ /^dbi:Ingres/;
$dbname;
}
sub connect_db($$) {
# Connects to the database.
# If this fails everything else is in vain!
my ($num_test, $dbname) = @_;
print "Testing: DBI->connect('$dbname'):\n"
view all matches for this distribution
view release on metacpan or search on metacpan
InterBase.pm view on Meta::CPAN
'Attribution' => 'DBD::InterBase by Edwin Pratomo and Daniel Ritz'});
$drh;
}
# taken from JWIED's DBD::mysql, with slight modification
sub _OdbcParse($$$)
{
my($class, $dsn, $hash, $args) = @_;
my($var, $val);
if (!defined($dsn))
view all matches for this distribution
view release on metacpan or search on metacpan
lib/DBD/JDBC.pm view on Meta::CPAN
$DBD::JDBC::ErrorMessages::sql_state = "IJDBC";
# This one is used in die, not set_err.
sub bad_autocommit_value($) {
return "Unsupported AutoCommit value $_[0]";
}
sub send_error($) {
return (100, $_[0], $sql_state);
}
sub recv_error($) {
return (101, $_[0], $sql_state);
}
sub ber_error($) {
return (102, $_[0], $sql_state);
}
sub missing_dsn_component($) {
return (103, "Missing $_[0] in dsn", $sql_state);
}
sub socket_error($) {
return (104, "Failed to open socket to server: $_[0]", $sql_state);
}
sub bad_execute() {
return (105, "Invalid execute response", $sql_state);
}
sub bad_func_method($) {
return (106, "Invalid func method name: $_[0]", $sql_state);
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
t/40blobs.t view on Meta::CPAN
use DBI;
use vars qw($test_dsn $test_user $test_password);
use lib '.', 't';
require 'lib.pl';
sub ShowBlob($) {
my ($blob) = @_;
my $b;
for (my $i = 0; $i < 8; $i++) {
if (defined($blob) && length($blob) > $i) {
$b = substr($blob, $i*32);
view all matches for this distribution
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
use DBI 1.21;
use DBI::DBD;
use strict;
sub getSQLDBCSDKFromIndepPath();
sub usageSQLDBCSDK;
sub checkSQLDBCSDKVersion;
my $dbi_dir = dbd_dbi_dir();
my $dbi_arch_dir = dbd_dbi_arch_dir();
Makefile.PL view on Meta::CPAN
die "Makefile.PL aborted.\n";
}
}
}
sub getSQLDBCSDKFromIndepPath(){
my $indep=undef;
if ($^O eq 'MSWin32') {
eval {require Win32API::Registry; }; if ($@) {return undef};
my ($key, $type);
Win32API::Registry::RegOpenKeyEx( Win32API::Registry::HKEY_LOCAL_MACHINE(), "SOFTWARE\\SAP\\SAP DBTech", 0, Win32API::Registry::KEY_READ(), $key )
view all matches for this distribution
view release on metacpan or search on metacpan
lib/DBD/Neo4p.pm view on Meta::CPAN
our $err = 0; # holds error code for DBI::err
our $errstr = ''; # holds error string for DBI::errstr
our $drh = undef; # holds driver handle once initialised
our $prefix = 'neo';
sub driver($$){
return $drh if $drh;
my($sClass, $rhAttr) = @_;
$sClass .= '::dr';
# install methods if nec.
lib/DBD/Neo4p.pm view on Meta::CPAN
package # hide from PAUSE
DBD::Neo4p::dr;
$DBD::Neo4p::dr::imp_data_size = 0;
sub connect($$;$$$) {
my($drh, $sDbName, $sUsr, $sAuth, $rhAttr)= @_;
#1. create database-handle
my ($outer, $dbh) = DBI::_new_dbh($drh, {
Name => $sDbName,
lib/DBD/Neo4p.pm view on Meta::CPAN
sub data_sources ($;$) {
my($drh, $rhAttr) = @_;
return;
}
sub disconnect_all($) { }
package #hide from PAUSE
DBD::Neo4p::db;
$DBD::Neo4p::db::imp_data_size = 0;
lib/DBD/Neo4p.pm view on Meta::CPAN
return $dbh->SUPER::STORE($sAttr => $sValue);
}
}
}
sub DESTROY($) {
my($dbh) = @_;
$dbh->disconnect;
# deal with the REST::Neo4p object
}
lib/DBD/Neo4p.pm view on Meta::CPAN
if ($param > $sth->FETCH('NUM_OF_PARAMS'));
$sth->{"${prefix}_param_values"}->[$param-1] = $value;
return 1;
}
sub execute($@) {
my ($sth, @bind_values) = @_;
$sth->finish if $sth->{Active}; # DBI::DBD example, follow up...
my $params = @bind_values ? \@bind_values : $sth->{"${prefix}_param_values"};
view all matches for this distribution
view release on metacpan or search on metacpan
examples/DbiTest.pl view on Meta::CPAN
##########################################
### Functions
##########################################
sub newDbh()
{my $dbh;
if(defined($options{DbSrcServer}) && defined($options{DbSrcLoginName}) && defined($options{DbSrcDatabase}))
{ my $dsn = "DRIVER={SQL Server};SERVER=$options{DbSrcServer};DATABASE=$options{DbSrcDatabase};NETWORK=dbmssocn;UID=$options{DbSrcLoginName};PWD=$options{DbSrcPassword}";
# print "DSN: $dsn\n\n";
examples/DbiTest.pl view on Meta::CPAN
return($dbh);
}
}
sub test($;$)
{ my ($outputTempate, $recurse) = @_;
my $dbh = newDbh();
my $queryInputParameter1 = 2222;
my $queryOutputParameter = $outputTempate;
view all matches for this distribution
view release on metacpan or search on metacpan
examples/ora_explain.pl view on Meta::CPAN
$SqlMarker = "/* This statement was generated by explain */";
################################################################################
# Switch the hourglass on or off
sub busy($)
{
my ($state) = @_;
if ($state && $PlanMain->grabCurrent()) { $PlanMain->Busy(-recurse => 1); }
else { $PlanMain->Unbusy(1); }
}
################################################################################
# Display an error message in a dialog
sub error($@)
{
my ($parent, @lines) = @_;
my ($msg, $height, $width);
$msg = join("\n", @lines);
examples/ora_explain.pl view on Meta::CPAN
$dialog->Popup;
}
################################################################################
sub about($;$)
{
my ($parent, $win) = @_;
my $msg = <<EOM;
$ProgName version $VERSION
examples/ora_explain.pl view on Meta::CPAN
return($dialog);
}
################################################################################
sub update_title()
{
$PlanMain->configure(-title =>
$User
? $User eq $Schema
? "$ProgName - connected to $DbName as $User"
examples/ora_explain.pl view on Meta::CPAN
);
}
################################################################################
sub help($)
{
my ($parent) = @_;
require Tk::Pod;
$parent->Pod(-file => $0, -scrollbars => "e");
}
################################################################################
# Login to the database. The new database handle is put into $Db, and the
# Oracle version number is put into $OracleVersion
sub login($$$)
{
my ($database, $username, $password) = @_;
busy(1);
# Close any existing handle
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Clear the plan tree & details windows
sub clear_plan()
{
$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
$PlanTree->delete("all") if ($PlanTree);
$PlanStep->delete("1.0", "end") if ($PlanStep);
}
################################################################################
# Clear the SQL editor pane
sub clear_editor()
{
$PlanTitle->configure(-text => "Query Plan") if ($PlanTitle);
$PlanTree->delete("all") if ($PlanTree);
$PlanStep->delete("1.0", "end") if ($PlanStep);
$PlanSql->delete("1.0", "end");
}
################################################################################
# Display the structure of an index
sub disp_index($$)
{
my ($owner, $index) = @_;
# Create the index definition frame
busy(1);
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Callback for adding/removing index definitions to a table dialog
sub disp_table_cb($$$$$)
{
my ($owner, $table, $num_cols, $index_fr, $index_bn) = @_;
# If this is the first time through, fetch the index definitions
busy(1);
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Display a popup dialog showing the structure of a table
sub disp_table($$)
{
my ($owner, $table) = @_;
# Create the dialog for displaying the object details
busy(1);
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Display the query plan tree
sub disp_plan_tree()
{
$PlanTitle->configure(-text => $Plan->{title});
$PlanTree->delete("all");
my $steps = 0;
foreach my $step (@{$Plan->{id}})
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Display the statistics for a given plan step
sub disp_plan_step($)
{
my ($key) = @_;
my $row = $Plan->{key}{$key};
$PlanStep->delete("1.0", "end");
my $info = "";
examples/ora_explain.pl view on Meta::CPAN
################################################################################
# Display a popup dialog showing the structure of the table or index used in
# the passed plan step
sub disp_plan_step_obj($)
{
my ($key) = @_;
# Get the plan step & return if it doesn't refer to an object
my $row = $Plan->{key}{$key};
examples/ora_explain.pl view on Meta::CPAN
################################################################################
# Display a list of available indexes on a table, and display the selected
# table definition
sub disp_index_popup($)
{
my ($key) = @_;
# Get the plan step & return if it doesn't refer to an object
my $row = $Plan->{key}{$key};
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Produce the query plan for the SQL in $PlanSql and store it in $Plan
sub _explain()
{
# Check there is some SQL
my $stmt = $PlanSql->get("1.0", "end");
$stmt =~ s/;//g;
die("You have not supplied any SQL\n") if ($stmt =~ /^\s*$/);
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Display a login dialog
sub login_dialog($)
{
my ($parent) = @_;
# Create the dialog
if (! $LoginDialog)
examples/ora_explain.pl view on Meta::CPAN
$LoginDialog->Popup();
}
################################################################################
sub schema_dialog($)
{
my ($parent) = @_;
if (! $Db)
{
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Open a file and read it into the SQL editor frame
sub open_file($)
{
# Open the file
my ($file) = @_;
use IO::File;
my $fh;
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Display a file open dialog & load into the SQL editor
sub open_dialog($)
{
my ($parent) = @_;
# Put up the dialog
require Cwd; import Cwd;
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Display a file save dialog & save the contents of the passed Text widget
sub save_dialog($$)
{
my ($parent, $text) = @_;
# Put up the dialog
require Cwd; import Cwd;
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Copy SQL from the grab window into the explain SQL editor
sub copy_sql($$)
{
my ($text, $tag) = @_;
return if (! defined($tag));
clear_editor();
$PlanSql->insert("end", $text->get("$tag.first", "$tag.last"));
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Display info from v$sqlarea for the selected statement in the SQL cache
sub disp_sql_cache_info($$)
{
my ($address, $puid) = @_;
# Empty the widget & prepare the SQL
$GrabDetails->delete("1.0", "end");
examples/ora_explain.pl view on Meta::CPAN
}
################################################################################
# Callback for whenever a bit of grabbed SQL is selected
sub grab_select_cb($$)
{
my ($text, $tag) = @_;
$text->tag("configure", $GrabSelection, -background => undef)
if ($GrabSelection);
$text->tag("configure", $tag, -background => "#43ce80");
examples/ora_explain.pl view on Meta::CPAN
# $sort_by is "asc" or "desc"
# $user is who first issued the statement (case insensitive)
# $pattern is a perl regexp used to filter the SQL
# $rows is the maximum number of rows to display
sub grab($$$$$$$)
{
my ($ordering, $order_by, $sort_by, $no_sys, $user, $pattern, $rows) = @_;
# Check we are logged on
die("You are not logged on to Oracle\n") if (! $Db);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/DBD/Ovrimos.pm view on Meta::CPAN
package DBD::Ovrimos::lowlevel;
#Declarations for low-level functions and constants
#Essentially a Perl port of the C low-level library
sub _plain_mesg($$);
sub sqlConnect($$$$);
sub sqlConnectOutcome();
sub sqlDisconnect($);
sub sqlAllocStmt($);
sub sqlFreeStmt($);
sub sqlSetConnIntOption($$$);
sub sqlGetConnIntOption($$);
sub sqlSetStmtIntOption($$$);
sub sqlGetStmtIntOption($$);
sub sqlSetRowsetSize($$);
sub sqlGetRowsetSize($);
sub sqlSetIntOption($$$$);
sub sqlGetIntOption($$$);
sub sqlExecDirect($$);
sub sqlPrepare($$);
sub sqlExec($);
sub sqlCloseCursor($);
sub sqlAsyncFinished($);
sub sqlCancel($);
sub sqlSetCursorName($$);
sub sqlGetCursorName($);
sub sqlNest($);
sub sqlCommit($);
sub sqlRollback($);
sub sqlGetConnPending($);
sub sqlGetStmtPending($);
sub sqlGetConnDiagnostics($);
sub sqlGetStmtDiagnostics($);
sub sqlGetExecutionPlan($);
sub sqlGetNativeQuery($);
sub sqlGetRowCount($);
sub sqlGetOutputColDescr($);
sub sqlGetOutputColNb($);
sub sqlGetOutputColName($$);
sub sqlGetOutputColType($$);
sub sqlGetOutputColLength($$);
sub sqlGetOutputColPrecision($$);
sub sqlGetOutputColScale($$);
sub sqlGetOutputColNullable($$);
sub sqlGetParamDescr($);
sub sqlGetParamNb($);
sub sqlGetParamType($$);
sub sqlGetParamLength($$);
sub sqlGetParamPrecision($$);
sub sqlGetParamScale($$);
sub sqlPutParam($$$);
sub sqlResetParams($);
sub sqlCursorThis($);
sub sqlCursorFirst($$);
sub sqlCursorNext($$);
sub sqlCursorLast($$);
sub sqlCursorPrev($$);
sub sqlCursorBookmark($$);
sub sqlCursorGetBookmark($);
sub sqlCursorMove($$$$);
sub sqlGotoRow($$);
sub sqlRowState($$);
sub sqlRowBookmark($$);
sub sqlColValue($$$);
sub sqlColIsNull($$$);
sub _type_size($);
sub _type_overhead($);
sub _byte_order();
sub _column_def_len() {37};
sub _MAXMESGLEN() { 1024*64 };
sub _column_width($);
sub _column_pack_template($);
sub _collapse_null_ind($);
# Here we build a custom packing/unpacking facility to handle values
# Note that BIGINT and UNSIGNED BIGINT are kept in hex
sub _pack($$$); #_pack(endianity,template,ref array of values) -> string
sub _unpack($$$); #_unpack(endianity,template,string) -> array of values
sub _swapstring($); #_swapstring(string) -> string
sub _unpack_coldefs($$$);
sub make_date($$$);
sub make_time($$$);
sub break_date($);
sub break_time($);
# template characters:
# a/A sint8/uint8
# b/B sint16/uint16
# c/C sint32/uint32
lib/DBD/Ovrimos.pm view on Meta::CPAN
# Y99 VARBINARY <num> chars including padding preceded by uint16 actual len
# z zero-terminated string
# z99 zero-terminated string in field <num> chars wide (excluding null)
# Constants that indicate type of failure for sqlConnect
sub c_ok() {0}
sub c_conn_failed() {1}
sub c_trans_failed() {2}
sub c_auth_failed() {3}
# Options
sub OPTION_ASYNC() {0}
sub OPTION_SEND_BOOKMARKS() {1}
sub OPTION_ISOLATION() {2}
# Row status indicators
sub ROW_OK() {0}
sub ROW_INEXISTANT() {1}
sub ROW_ERROR() {2}
# Return codes
sub RET_OK() {0}
sub RET_STILL_EXEC() {1}
sub RET_ERROR() {2}
# Types
sub T_CHAR() {1}
sub T_VARCHAR() {12}
sub T_LONGVARCHAR() {-1}
sub T_DECIMAL() {3}
sub T_NUMERIC() {2}
sub T_SMALLINT() {5}
sub T_INTEGER() {4}
sub T_REAL() {7}
sub T_FLOAT() {6}
sub T_DOUBLE() {8}
sub T_BIT() {-7}
sub T_TINYINT() {-6}
sub T_BIGINT() {-5}
sub T_BINARY() {-2}
sub T_VARBINARY() {-3}
sub T_LONGVARBINARY() {-4}
sub T_DATE() {9}
sub T_TIME() {10}
sub T_TIMESTAMP() {11}
sub T_USMALLINT() {20}
sub T_UINTEGER() {21}
sub T_UTINYINT() {22}
sub T_UBIGINT() {23}
# Byte orders
sub BYTE_ORDER_LITTLE() {0}
sub BYTE_ORDER_BIG() {1}
# Messages
sub FUNC_LOGIN() {0}
sub FUNC_LOGOUT() {1}
sub FUNC_ALLOC_STMT() {2}
lib/DBD/Ovrimos.pm view on Meta::CPAN
sub FUNC_CALL() {35}
sub FUNC_BULK() {36}
#
sub _pack($$$) {
my $endianity=shift;
my $template=shift;
my $valuesref=shift;
my ($buf,$index);
my $len=scalar @$valuesref;
lib/DBD/Ovrimos.pm view on Meta::CPAN
$buf .= $bitstring;
}
$buf;
}
sub _unpack($$$) {
my ($endianity,$template,$buf)=@_;
my @values=();
while(length($template)>0) {
my $c=substr($template,0,1);
$template=substr($template,1);
lib/DBD/Ovrimos.pm view on Meta::CPAN
push @values,$val;
}
@values;
}
sub _swapstring($) {
my $str=shift;
my $len=length($str);
my $i;
for($i=0; $i<$len/2; $i++) {
my $t;
lib/DBD/Ovrimos.pm view on Meta::CPAN
substr($str,$len-$i-1,1)=$t;
}
$str;
}
sub make_date($$$) {
my ($yy,$mm,$dd)=@_;
$yy*2^16+$mm*256+$dd;
}
sub make_time($$$) {
my ($hh,$mm,$ss)=@_;
$hh*3600+$mm*60+$ss;
}
sub break_date($) {
my $num=shift;
my $dd=$num%256;
my $mm=($num>>8)%256;
my $yy=($num>>16);
if(wantarray) {
lib/DBD/Ovrimos.pm view on Meta::CPAN
} else {
return sprintf 'DATE %04d-%02d-%02d', $yy, $mm, $dd;
}
}
sub break_time($) {
my $num=shift;
my $hh=int($num/3600);
my $mm=int(($num%3600)/60);
my $ss=$num%60;
if(wantarray) {
lib/DBD/Ovrimos.pm view on Meta::CPAN
sprintf 'TIME %02d:%02d:%02d', $hh, $mm, $ss;
}
}
# Find out local byte order
sub _byte_order() {
my $local_short=pack 's',[300];
my $big_endian_short=pack 'n',[300];
if($local_short eq $big_endian_short) {
return BYTE_ORDER_BIG;
} else {
lib/DBD/Ovrimos.pm view on Meta::CPAN
g => 4,
h => 4,
);
}
sub _plain_mesg($$) {
my $stmtref=shift;
my $func=shift;
my $connref=$$stmtref{'Database'};
my @arg=(0,$$stmtref{stmt_handle},$func);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
lib/DBD/Ovrimos.pm view on Meta::CPAN
return undef;
}
$ret==RET_OK;
}
sub sqlConnect($$$$) {
my ($server,$port,$username,$password) = @_;
my ($so,$endianity,$buf);
$DBD::Ovrimos::lowlevel::_outcome=c_conn_failed;
$so=IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$server,PeerPort=>$port);
return undef unless defined($so);
lib/DBD/Ovrimos.pm view on Meta::CPAN
'Active' =>1,
'AGI' =>0,
};
}
sub sqlConnectOutcome() {
$DBD::Ovrimos::lowlevel::_outcome;
}
sub sqlDisconnect($) {
my $connref=shift;
$$connref{'Active'}=0;
my @arg=(0,0,FUNC_LOGOUT);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
}
$$connref{osocket}->close() or return undef;
$ret==RET_OK;
}
sub sqlAllocStmt($) {
my $connref=shift;
unless(defined($connref)) { return undef; }
my @arg=(0,0,FUNC_ALLOC_STMT);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
currrow=>0,
'Active'=>1,
};
}
sub sqlFreeStmt($) {
my $stmtref=shift;
my $ret=_plain_mesg($stmtref,FUNC_FREE_STMT);
$$stmtref{'Active'}=0;
$ret;
}
sub sqlAsyncFinished($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_STILL_EXEC);
}
sub sqlCancel($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_CANCEL);
}
sub sqlPutParam($$$) {
my $stmtref=shift;
my $num=shift;
my $val=shift;
if($num<0 || $num>=$$stmtref{paramcount}) {
return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
return undef;
}
$ret==RET_OK;
}
sub sqlResetParams($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_RESET_PARAMS);
}
sub sqlPrepare($$) {
my $stmtref=shift;
my $cmd=shift;
my $connref=$$stmtref{'Database'};
my @arg=(length($cmd)+1,$$stmtref{stmt_handle},FUNC_PREPARE,$cmd);
my $buf=_pack($$connref{endianity},"BBBz",\@arg);
lib/DBD/Ovrimos.pm view on Meta::CPAN
return undef;
}
$ret==RET_OK;
}
sub sqlExecDirect($$) {
my $stmtref=shift;
my $cmd=shift;
my $connref=$$stmtref{'Database'};
my $func=FUNC_EXEC_DIRECT;
if($cmd=~/call (.*)/i) {
lib/DBD/Ovrimos.pm view on Meta::CPAN
return undef;
}
$ret==RET_OK;
}
sub sqlExec($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_EXEC);
}
sub sqlCloseCursor($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_END_EXEC);
}
sub sqlSetCursorName($$) {
my $stmtref=shift;
my $cname=shift;
my $connref=$$stmtref{'Database'};
my @arg=(length($cname)+1,$$stmtref{stmt_handle},FUNC_SET_NAME,$cname);
my $buf=_pack($$connref{endianity},"BBBz",\@arg);
lib/DBD/Ovrimos.pm view on Meta::CPAN
return undef;
}
$ret==RET_OK;
}
sub sqlGetCursorName($) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my @arg=(0,$$stmtref{stmt_handle},FUNC_GET_NAME);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
return $x;
}
undef;
}
sub sqlGetExecutionPlan($) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my @arg=(0,$$stmtref{stmt_handle},FUNC_GET_EXEC_PLAN);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
return $x;
}
undef;
}
sub sqlGetNativeQuery($) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my @arg=(0,$$stmtref{stmt_handle},FUNC_GET_NATIVE_QUERY);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
return $x;
}
undef;
}
sub sqlGetRowCount($) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my @arg=(0,$$stmtref{stmt_handle},FUNC_GET_ROW_COUNT);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
return _unpack($$connref{endianity},"C",$buf);
}
undef;
}
sub sqlSetConnIntOption($$$) {
my $connref=shift;
my $option=shift;
my $value=shift;
sqlSetIntOption($connref,undef,$option,$value);
}
sub sqlGetConnIntOption($$) {
my $connref=shift;
my $option=shift;
sqlGetIntOption($connref,undef,$option);
}
sub sqlSetStmtIntOption($$$) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my $option=shift;
my $value=shift;
sqlSetIntOption($connref,$stmtref,$option,$value);
}
sub sqlGetStmtIntOption($$) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my $option=shift;
sqlGetIntOption($connref,$stmtref,$option);
}
sub sqlSetIntOption($$$$) {
my $connref=shift;
my $stmtref=shift;
my $option=shift;
my $value=shift;
my $func=FUNC_OPTION_SET;
lib/DBD/Ovrimos.pm view on Meta::CPAN
$$connref{pending}=$pending;
}
$ret==RET_OK;
}
sub sqlGetIntOption($$$) {
my $connref=shift;
my $stmtref=shift;
my $option=shift;
my $value=shift;
my $func=FUNC_OPTION_GET;
lib/DBD/Ovrimos.pm view on Meta::CPAN
}
$$connref{isocket}->read($buf,$len) or return undef;
_unpack($$connref{endianity},"c",$buf);
}
sub sqlGetConnDiagnostics($) {
my $connref=shift;
sqlGetDiagnostics($connref,undef);
}
sub sqlGetStmtDiagnostics($) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
sqlGetDiagnostics($connref,$stmtref);
}
sub sqlGetDiagnostics($$) {
my $connref=shift;
my $stmtref=shift;
my $stmt_handle=0;
my $func=FUNC_GET_DIAGS;
if(defined($stmtref)) {
lib/DBD/Ovrimos.pm view on Meta::CPAN
$$connref{isocket}->read($buf,$len) or return undef;
my ($diags)=_unpack($$connref{endianity},"z",$buf);
$diags;
}
sub sqlNest($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_NEST);
}
sub sqlCommit($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_COMMIT);
}
sub sqlRollback($) {
my $stmtref=shift;
_plain_mesg($stmtref,FUNC_ROLLBACK);
}
sub sqlGetConnPending($) {
my $connref=shift;
$$connref{pending};
}
sub sqlGetStmtPending($) {
my $stmtref=shift;
$$stmtref{pending};
}
sub _unpack_coldefs($$$) {
my $endianity=shift;
my $colnb=shift;
my $buf=shift;
my $i;
my @res=();
lib/DBD/Ovrimos.pm view on Meta::CPAN
push(@res,\%coldef);
}
@res;
}
sub sqlGetParamDescr($) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my @arg=(0,$$stmtref{stmt_handle},FUNC_DESCRIBE_PARAMS);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
$$stmtref{paramcount}=$colnb;
$$stmtref{params}=\@params;
$ret==RET_OK;
}
sub sqlGetParamNb($) {
my $stmtref=shift;
$$stmtref{paramcount};
}
sub sqlGetParamType($$) {
my $stmtref=shift;
my $icol=shift;
my $paramsc=$$stmtref{params};
my $coldef=$$paramsc[$icol];
$$coldef{type};
}
sub sqlGetParamLength($$) {
my $stmtref=shift;
my $icol=shift;
my $paramsc=$$stmtref{params};
my $coldef=$$paramsc[$icol];
$$coldef{len};
}
sub sqlGetParamPrecision($$) {
my $stmtref=shift;
my $icol=shift;
my $paramsc=$$stmtref{params};
my $coldef=$$paramsc[$icol];
$$coldef{len};
}
sub sqlGetParamScale($$) {
my $stmtref=shift;
my $icol=shift;
my $paramsc=$$stmtref{params};
my $coldef=$$paramsc[$icol];
$$coldef{scale};
}
sub sqlGetOutputColDescr($) {
my $stmtref=shift;
my $connref=$$stmtref{'Database'};
my @arg=(0,$$stmtref{stmt_handle},FUNC_DESCRIBE_RES_COLS);
my $buf=_pack($$connref{endianity},"BBB",\@arg);
$$connref{osocket}->write($buf,length($buf)) or return undef;
lib/DBD/Ovrimos.pm view on Meta::CPAN
$$stmtref{row_template}.=_column_pack_template($coldefref);
}
$ret==RET_OK;
}
sub sqlGetOutputColNb($) {
my $stmtref=shift;
$$stmtref{colnb};
}
sub sqlGetOutputColName($$) {
my $stmtref=shift;
my $icol=shift;
my $resc=$$stmtref{res};
my $coldef=$$resc[$icol];
$$coldef{name};
}
sub sqlGetOutputColType($$) {
my $stmtref=shift;
my $icol=shift;
my $resc=$$stmtref{res};
my $coldef=$$resc[$icol];
$$coldef{type};
}
sub sqlGetOutputColLength($$) {
my $stmtref=shift;
my $icol=shift;
my $resc=$$stmtref{res};
my $coldef=$$resc[$icol];
$$coldef{len};
}
sub sqlGetOutputColPrecision($$) {
my $stmtref=shift;
my $icol=shift;
my $resc=$$stmtref{res};
my $coldef=$$resc[$icol];
$$coldef{len};
}
sub sqlGetOutputColScale($$) {
my $stmtref=shift;
my $icol=shift;
my $resc=$$stmtref{res};
my $coldef=$$resc[$icol];
$$coldef{scale};
}
sub sqlGetOutputColNullable($$) {
my $stmtref=shift;
my $icol=shift;
my $resc=$$stmtref{res};
my $coldef=$$resc[$icol];
$$coldef{nullable};
}
sub sqlGetRowsetSize($) {
my $stmtref=shift;
$$stmtref{rowset_size};
}
sub sqlSetRowsetSize($$) {
my $stmtref=shift;
my $sz=shift;
my $row_width=$$stmtref{row_width};
my $max_sz=int((_MAXMESGLEN-2-6)/($row_width+6));
if($sz>$max_sz) {
$sz=$max_sz;
}
$$stmtref{rowset_size}=$sz;
}
sub _column_width($) {
my $coldefref=shift;
my $type=$$coldefref{type};
my $len=$$coldefref{len};
my $w;
if($type==T_DECIMAL || $type==T_NUMERIC) {
lib/DBD/Ovrimos.pm view on Meta::CPAN
$w=$len*_type_size($type)+_type_overhead($type);
}
$w+1; #plus null indicator
}
sub _column_pack_template($) {
my $coldefref=shift;
my $t=$$coldefref{type};
my $len=$$coldefref{len};
if($t==T_BIGINT) {
return "Ad"
lib/DBD/Ovrimos.pm view on Meta::CPAN
} else {
return undef;
}
}
sub _type_size($) {
my $t=shift;
if($t==T_TIMESTAMP || $t==T_BIGINT || $t==T_UBIGINT ||
$t==T_DECIMAL || $t==T_NUMERIC || $t==T_DOUBLE || $t==T_FLOAT) {
return 8;
} elsif($t==T_INTEGER || $t==T_UINTEGER || $t==T_TIME || $t==T_DATE ||
lib/DBD/Ovrimos.pm view on Meta::CPAN
} else {
return 1;
}
}
sub _type_overhead($) {
my $t=shift;
if($t==T_CHAR || $t==T_VARCHAR) {
return 1;
} elsif($t==T_VARBINARY) {
return 2;
lib/DBD/Ovrimos.pm view on Meta::CPAN
} else {
return 0;
}
}
sub sqlCursorMove($$$$) {
my $stmtref=shift;
my $irow=shift;
my $func=shift;
my $fetch=shift;
my $connref=$$stmtref{'Database'};
lib/DBD/Ovrimos.pm view on Meta::CPAN
$$stmtref{rows}=\@rows;
$$stmtref{currrow}=0;
$ret==RET_OK;
}
sub _collapse_null_ind($) {
my $listref=shift;
my @data=();
my $i;
for($i=0; $i<scalar(@$listref); $i+=2) {
if($$listref[$i]==0) {
lib/DBD/Ovrimos.pm view on Meta::CPAN
}
}
\@data;
}
sub sqlCursorThis($) {
my $stmtref=shift;
sqlCursorMove($stmtref,0,FUNC_CURSOR_THIS,$$stmtref{rowset_size});
}
sub sqlCursorFirst($$) {
my $stmtref=shift;
my $irow=shift;
sqlCursorMove($stmtref,$irow,FUNC_CURSOR_FIRST,$$stmtref{rowset_size});
}
sub sqlCursorNext($$) {
my $stmtref=shift;
my $irow=shift;
sqlCursorMove($stmtref,$irow,FUNC_CURSOR_NEXT,$$stmtref{rowset_size});
}
sub sqlCursorLast($$) {
my $stmtref=shift;
my $irow=shift;
sqlCursorMove($stmtref,$irow,FUNC_CURSOR_LAST,$$stmtref{rowset_size});
}
sub sqlCursorPrev($$) {
my $stmtref=shift;
my $irow=shift;
sqlCursorMove($stmtref,$irow,FUNC_CURSOR_PREV,$$stmtref{rowset_size});
}
sub sqlCursorBookmark($$) {
my $stmtref=shift;
my $bm=shift;
sqlCursorMove($stmtref,$bm,FUNC_CURSOR_GOTO_BM,$$stmtref{rowset_size});
}
sub sqlColValue($$$) {
my $stmtref=shift;
my $icol=shift;
my $irow=shift;
my $rows=$$stmtref{rows};
my $row=$$rows[$irow];
my $data=$$row{data};
#$$$$$stmtref{rows}[$irow]{data}[$icol];
$$data[$icol];
}
sub sqlColIsNull($$$) {
my $stmtref=shift;
my $icol=shift;
my $irow=shift;
undefined(sqlColValue($stmtref,$icol,$irow));
}
sub sqlRowState($$) {
my $stmtref=shift;
my $irow=shift;
my $rows=$$stmtref{rows};
my $row=$$rows[$irow];
$$row{state};
}
sub sqlRowBookmark($$) {
my $stmtref=shift;
my $irow=shift;
my $rows=$$stmtref{rows};
my $row=$$rows[$irow];
$$row{bookmark};
lib/DBD/Ovrimos.pm view on Meta::CPAN
'Errstr' => \$DBD::Ovrimos::errStr,
'Atribution' => 'DBD::Ovrimos by Dimitrios Souflis',
});
}
sub AGIdb() {
my ($ofh,$ifh);
$ofh=new IO::Handle;
$ifh=new IO::Handle;
if(!$ifh->fdopen(fileno(STDIN),"r")) {
return undef;
view all matches for this distribution
view release on metacpan or search on metacpan
t/10dsnlist.t view on Meta::CPAN
print "1..0\n";
exit 0;
}
print "Driver is $mdriver\n";
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
view all matches for this distribution
view release on metacpan or search on metacpan
}
$next++;
return("table$next");
}
sub export() {
my $dbh = shift;
my $args = shift || die "No arguments for export()\n";
my $msg = "export() requires ";
my $sql = $args->{data_source} || die $msg . '{data_source => $}';
my $f_name = $args->{data_target} || die 'export requires {data_target => $f}';
$sth2->execute(@row);
}
delete $DBD::RAM::ramdata->{catalog}{$temp_table};
}
sub export_xml() {
my $dbh = shift;
my $args = shift;
my $msg = "Export to XML requires ";
my $sql = $args->{data_source} || die $msg . '{data_source => $}';
my $f_name = $args->{data_target} || die $msg . '{data_target => $f}';
my $footer;
for (@tag_ends) { $footer .= $_; }
return($header,$terminal_tag,$footer);
}
sub convert() {
my $dbh = shift;
my $specs = shift;
my $source_type = $specs->{source_type} || '';
my $source_file = $specs->{source_file} || '';
my $source_params = $specs->{source_params} || '';
}
if ($source_type eq 'DBI' ) { $dbh2->disconnect; }
}
sub import() {
my $dbh = shift;
my $specs = shift;
my $data = shift;
if ($specs && ! $data ) {
if (ref $specs eq 'ARRAY' ) {
view all matches for this distribution
view release on metacpan or search on metacpan
$errstr = ""; #holds error string for DBI:errstr
$sqlstate = ""; #holds SQL state for DBI::state
$drh = undef; #holds driver handle once initialized
sub driver($;$)
{
return $drh if defined($drh);
my ($class, $attr) = @_;
$class .= "::dr";
###############################################################################
package DBD::Redbase::dr; # =========== Driver ==============
$DBD::Redbase::dr::imp_data_size = 0;
sub connect($$;$$$)
{
my ($drh, $dbname, $user, $auth, $attr) = @_;
my $dbh;
my $var;
my $port;
#the connection if it's successfull only if it's a failure
return $dbh;
}
sub data_sources($$)
{
return ();
}
sub disconnect_all($)
{
}
###############################################################################
# Database package follows
###############################################################################
package DBD::Redbase::db;
$DBD::Redbase::db::imp_data_size = 0;
sub prepare($$;@)
{
my ($dbh, $statement, @attr) = @_;
my $sth;
$sth = DBI::_new_sth($dbh, {'Statement' => $statement});
return $sth;
}
#XXX retunr error if cannot close socket
sub disconnect($)
{
my ($dbh) = @_;
my $socket;
my $ds;
$socket = $dbh->FETCH("redbase_socket");
return $socket->close();
}
sub FETCH($$)
{
my ($dbh, $attr) = @_;
if (($attr eq lc($attr)) || ($attr eq 'AutoCommit'))
{
{
return $dbh->DBD::_::db::FETCH($attr);
}
}
sub STORE($$$)
{
#Special handling required for AutoCommit
my ($dbh, $attr, $value) = @_;
}
}
#XXX Not implemented yet
sub type_info_all($)
{
my ($dbh) = @_;
}
sub commit($)
{
my ($dbh) = @_;
if ($dbh->FETCH('AutoCommit'))
{
if ($dbh->FETCH('Warn'))
{
return $dbh->do("COMMIT");
}
}
sub rollback($)
{
my ($dbh) = @_;
if ($dbh->FETCH('AutoCommit'))
{
if ($dbh->FETCH('Warn'))
{
return $dbh->do("ROLLBACK");
}
}
sub quote($$;$)
{
my ($dbh, $str, $type) = @_;
if (defined($type) &&
(
sub DESTROY
{
undef;
}
sub _list_tables($)
{
my ($dbh) = @_;
my $sth;
my @tables = ();
my $row;
70 => "DATALINK",
16 => "BOOLEAN",
100 => "VARCHAR_IGNORECASE",
};
sub bind_param($$$$)
{
my ($sth, $pNum, $val, $attr) = @_;
my $params;
my $type;
my $dbh;
$params->[$pNum - 1] = $val;
return 1;
}
sub execute($@)
{
my ($sth, @bind_values) = @_;
my $statement;
my $params;
my $param_number;
return @data || '0E0';
}
}
sub fetch($)
{
my ($sth) = @_;
my $data;
my $row;
return $sth->_set_fbav($row);
}
*fetchrow_arrayref = \&fetch;
sub rows($)
{
my ($sth) = @_;
return $sth->FETCH('redbase_rows');
}
sub finish($)
{
my ($sth) = @_;
undef $sth->{'redbase_data'};
undef $sth->{'redbase_rows'};
$sth->DBD::_::st::finish();
return 1;
}
sub FETCH($$)
{
my ($sth, $attr) = @_;
if ($attr eq 'NAME')
{
{
return $sth->DBD::_::st::FETCH($attr);
}
}
sub STORE($$$)
{
my ($sth, $attr, $value) = @_;
if ($attr eq 'NAME')
{
return $sth->DBD::_::st::STORE($attr, $value);
}
}
sub DESTROY($)
{
undef;
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
t/20_blobs.t view on Meta::CPAN
use t::lib::Test;
use Test::More tests => 10;
use Test::NoWarnings;
use DBI ':sql_types';
sub ShowBlob($) {
my ($blob) = @_;
print("showblob length: ", length($blob), "\n");
if ($ENV{SHOW_BLOBS}) { open(OUT, ">>$ENV{SHOW_BLOBS}") }
my $i = 0;
while (1) {
view all matches for this distribution
view release on metacpan or search on metacpan
t/20_blobs.t view on Meta::CPAN
use SQLeetTest;
use Test::More tests => 17;
use Test::NoWarnings;
use DBI ':sql_types';
sub ShowBlob($) {
my ($blob) = @_;
print("showblob length: ", length($blob), "\n");
if ($ENV{SHOW_BLOBS}) { open(OUT, ">>$ENV{SHOW_BLOBS}") }
my $i = 0;
while (1) {
view all matches for this distribution
view release on metacpan or search on metacpan
t/10dsnlist.t view on Meta::CPAN
print "1..0\n";
exit 0;
}
print "Driver is $mdriver\n";
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
view all matches for this distribution
view release on metacpan or search on metacpan
t/20_blobs.t view on Meta::CPAN
use SQLiteTest;
use Test::More;
use if -d ".git", "Test::FailWarnings";
use DBI ':sql_types';
sub ShowBlob($) {
my ($blob) = @_;
print("showblob length: ", length($blob), "\n");
if ($ENV{SHOW_BLOBS}) { open(OUT, ">>$ENV{SHOW_BLOBS}") }
my $i = 0;
while (1) {
view all matches for this distribution
view release on metacpan or search on metacpan
t/10dsnlist.t view on Meta::CPAN
print "1..0\n";
exit 0;
}
print "Driver is $mdriver\n";
sub ServerError() {
print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
"\tEither your server is not up and running or you have no\n",
"\tpermissions for acessing the DSN $test_dsn.\n",
"\tThis test requires a running server and write permissions.\n",
"\tPlease make sure your server is running and you have\n",
view all matches for this distribution
view release on metacpan or search on metacpan
lib/DBD/Sys.pm view on Meta::CPAN
$VERSION = "0.102";
$drh = undef; # holds driver handle(s) once initialised
sub driver($;$)
{
my ( $class, $attr ) = @_;
$drh->{$class} and return $drh->{$class};
lib/DBD/Sys.pm view on Meta::CPAN
use Scalar::Util qw(weaken);
@ISA = qw(DBI::DBD::SqlEngine::Statement);
sub open_table($$$$$)
{
my ( $self, $data, $table, $createMode, $lockMode ) = @_;
my $attr_prefix = 'sys_' . lc($table) . '_';
my $attrs = {};
view all matches for this distribution