^sub \w+\( results from the CPAN

^sub \w+\(

DBD-Ovrimos

view release on metacpan or search on metacpan


require 5.003;
use strict;
use IO::Socket;

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
# d/D     sint64/uint64
# f/F     float/double
# g       date 'DATE YYYY-MM-DD'
# h       time 'TIME HH:MM:SS'
# i       timestamp 'TIMESTAMP YYYY-MM-DD HH:MM:SS'
# y99     <num> chars : fixed length BINARY
# 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}
 sub FUNC_FREE_STMT() {3}
 sub FUNC_EXEC() {4}
 sub FUNC_CURSOR_THIS() {5}
 sub FUNC_OPTION_SET() {6}
 sub FUNC_OPTION_GET() {7}

lib/DBD/Ovrimos.pm view on Meta::CPAN

 sub FUNC_GET_NAME() {30}
 sub FUNC_GET_ROW_COUNT() {31}
 sub FUNC_CURSOR_GET_BM() {32}
 sub FUNC_CURSOR_GOTO_BM() {33}
 sub FUNC_CANCEL() {34}
 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;
 for($index=0;$index<$len;$index++) {
     my $c=substr($template,0,1);
     $template=substr($template,1);
     my $val=$$valuesref[$index];
     my $bitstring;

lib/DBD/Ovrimos.pm view on Meta::CPAN

          $bitstring=pack $templ,$val;
          if($endianity!=$DBD::Ovrimos::lowlevel::_local_byte_order) {
               $bitstring=_swapstring($bitstring);
          }
     }
     $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);
     my $val;
     if($c eq 'z' || $c eq 'y' || $c eq 'Y') {
          my $len;
          my $xlen=1;
          my $keeplen;

lib/DBD/Ovrimos.pm view on Meta::CPAN

               $val=break_date($val);
          } elsif($c eq 'h') {
               $val=break_time($val);
          }
     }
     push @values,$val;
 }
 @values;
}

sub _swapstring($) {
 my $str=shift;
 my $len=length($str);
 my $i;
 for($i=0; $i<$len/2; $i++) {
     my $t;
     $t=substr($str,$i,1);
     substr($str,$i,1)=substr($str,$len-$i-1,1);
     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) {
     return ($yy,$mm,$dd);
 } 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) {
     return ($hh,$mm,$ss);
 } else {
     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 {
          return BYTE_ORDER_LITTLE;
     }
}

BEGIN {

lib/DBD/Ovrimos.pm view on Meta::CPAN

     C => 4,
     d => 8,
     D => 8,
     f => 4,
     F => 8,
     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);
 $$connref{osocket}->write($buf,length($buf)) or return undef;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     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);
 $DBD::Ovrimos::lowlevel::_outcome=c_trans_failed;
 return undef unless 1==$so->read($endianity,1);
 $endianity=ord($endianity);
 my @arg=
     (length($username)+1,$username,length($password)+1,$password);

lib/DBD/Ovrimos.pm view on Meta::CPAN

     'isocket'      =>$so,
     'stmts'        =>\@empty_array,
     'AutoCommit'   =>1,
     'PrintError'   =>1,
     'RaiseError'   =>0,
     '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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$connref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     return undef;
 }
 $$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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$connref{isocket}->read($buf,$len) or return undef;
 unless($len==2) { return undef; }

lib/DBD/Ovrimos.pm view on Meta::CPAN

 my ($stmt)=_unpack($$connref{endianity},"B",$buf);
 {
     'Database'=>$connref,
     stmt_handle=>$stmt,
     rowset_size=>1,
     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;
 }
 my $connref=$$stmtref{'Database'};
 my @arg;
 my $buf;
 if(defined($val)) {

lib/DBD/Ovrimos.pm view on Meta::CPAN

 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     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);
 $$connref{osocket}->write($buf,length($buf)) or return undef;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     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) {
     $func=FUNC_CALL;
     $cmd=$1;
 }
 my @arg=(length($cmd)+1,$$stmtref{stmt_handle},$func,$cmd);
 my $buf=_pack($$connref{endianity},"BBBz",\@arg);

lib/DBD/Ovrimos.pm view on Meta::CPAN

 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     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);
 $$connref{osocket}->write($buf,length($buf)) or return undef;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     my ($x)=_unpack($$connref{endianity},"z",$buf);
     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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     my ($x)=_unpack($$connref{endianity},"z",$buf);
     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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     my ($x)=_unpack($$connref{endianity},"z",$buf);
     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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len!=0) {
     $$connref{isocket}->read($buf,$len) or return undef;
     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;
 my $stmt_handle=0;
 if(defined($stmtref)) {
     $func=FUNC_OPTION_SET;
     $stmt_handle=$$stmtref{stmt_handle};
 }

lib/DBD/Ovrimos.pm view on Meta::CPAN

 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 if(defined($stmtref)) {
     $$stmtref{pending}=$pending;
 } else {
     $$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;
 my $stmt_handle=0;
 if(defined($stmtref)) {
     $func=FUNC_OPTION_GET;
     $stmt_handle=$$stmtref{stmt_handle};
 }

lib/DBD/Ovrimos.pm view on Meta::CPAN

 } else {
     $$connref{pending}=$pending;
 }
 if($len!=4) {
     return undef;
 }
 $$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)) {
     $func=FUNC_GET_STMT_DIAGS;
     $stmt_handle=$$stmtref{stmt_handle};
 }
 my @arg=(2,$stmt_handle,$func,64*1024-10);
 my $buf=_pack($$connref{endianity},"BBBB",\@arg);

lib/DBD/Ovrimos.pm view on Meta::CPAN

     if($pending!=0) {
          return undef;  #oops! diagnostics that are not received?
     }
     return 1;           #ok, no diagnostics
 }
 $$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=();
 for($i=0; $i<$colnb; $i++) {
     my ($name,$type,$length,$scale,$nullable)=_unpack($endianity,"z30abbA",$buf);
     $buf=substr($buf,_column_def_len);
     my %coldef=(
          name => $name,
          type => $type,
          len => $length,
          scale => $scale,
          nullable => $nullable,
     );
     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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len==0) { return undef; }
 $$connref{isocket}->read($buf,$len) or return undef;
 my ($colnb)=_unpack($$connref{endianity},"B",$buf); $buf=substr($buf,2);
 my @params=_unpack_coldefs($$connref{endianity},$colnb,$buf);
 $$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;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;
 my ($len,$ret,$pending)=_unpack($$connref{endianity},"BBB",$buf);
 $$stmtref{pending}=$pending;
 if($len==0) { return undef; }

lib/DBD/Ovrimos.pm view on Meta::CPAN

 $$stmtref{row_width}=0;
 $$stmtref{row_template}='';
 my $coldefref;
 foreach $coldefref (@res) {
     $$stmtref{row_width}+=_column_width($coldefref);
     $$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) {
     $w=_type_size($type);
 } else {
     $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"
 } elsif($t==T_TIMESTAMP) {
     return "Ai";
 } elsif($t==T_UBIGINT) {
     return "AD"
 } elsif($t==T_DECIMAL || $t==T_NUMERIC || $t==T_DOUBLE || $t==T_FLOAT) {

lib/DBD/Ovrimos.pm view on Meta::CPAN

     return "Az" . $len;
 } elsif($t==T_BINARY) {
     return "Ay" . $len;
 } elsif($t==T_VARBINARY) {
     return "AY" . $len;
 } 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 ||
    $t==T_REAL) {
     return 4;
 } elsif($t==T_SMALLINT || $t==T_USMALLINT) {
     return 2;
 } elsif($t==T_LONGVARCHAR || $t==T_LONGVARBINARY) {
     return 0;
     # so that 0*length+type_overhead=type_overhead
 } else {
     return 1;
 }
}

sub _type_overhead($) {
 my $t=shift;
 if($t==T_CHAR || $t==T_VARCHAR) {
     return 1;
 } elsif($t==T_VARBINARY) {
     return 2;
 } elsif($t==T_LONGVARCHAR || $t==T_LONGVARBINARY) {
     return 4;
 } else {
     return 0;
 }
}

sub sqlCursorMove($$$$) {
 my $stmtref=shift;
 my $irow=shift;
 my $func=shift;
 my $fetch=shift;
 my $connref=$$stmtref{'Database'};
 my @arg=(6,$$stmtref{stmt_handle},$func,$fetch,$irow);
 my $buf=_pack($$connref{endianity},"BBBBC",\@arg);
 $$connref{osocket}->write($buf,length($buf)) or return undef;
 $$connref{osocket}->flush() or return undef;
 $$connref{isocket}->read($buf,6) or return undef;

lib/DBD/Ovrimos.pm view on Meta::CPAN

          $rw=_collapse_null_ind(\@x);
     }
     my %rowdata=( state=> $st, bookmark=> $bm, data=>$rw);
     push(@rows,\%rowdata);
 }
 $$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) {
          push(@data,$$listref[$i+1]);
     } else {
          push(@data,undef);
     }
 }
 \@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};
}

package DBD::Ovrimos;

use vars qw($VERSION);      #so that VERSION_FROM will work

lib/DBD/Ovrimos.pm view on Meta::CPAN

 $DBD::Ovrimos::drh=DBI::_new_drh('DBD::Ovrimos::dr',
     {
          'Name'         => 'Ovrimos',
          'Version'      => $DBD::Ovrimos::VERSION,
          'Err'          => \$DBD::Ovrimos::err,
          '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;
 }
 if(!$ofh->fdopen(fileno(STDOUT),"w")) {
     return undef;
 }
 my @empty_array=();

( run in 0.268 second using v1.01-cache-2.11-cpan-1f129e94a17 )