home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / Win32 / ODBC.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  16.2 KB  |  716 lines
  1. package Win32::ODBC;
  2.  
  3. $VERSION = '0.03';
  4.  
  5.  
  6. require Exporter;
  7. require DynaLoader;
  8.  
  9. $ODBCPackage = "Win32::ODBC";
  10. $ODBCPackage::Version = 970208;
  11. $::ODBC = $ODBCPackage;
  12. $CacheConnection = 0;
  13.  
  14. *ODBC::=\%Win32::ODBC::;
  15.  
  16.  
  17. @ISA= qw( Exporter DynaLoader );
  18. @EXPORT = qw(
  19.             ODBC_ADD_DSN
  20.             ODBC_REMOVE_DSN
  21.             ODBC_CONFIG_DSN
  22.  
  23.             SQL_DONT_CLOSE
  24.             SQL_DROP
  25.             SQL_CLOSE
  26.             SQL_UNBIND
  27.             SQL_RESET_PARAMS
  28.  
  29.             SQL_FETCH_NEXT
  30.             SQL_FETCH_FIRST
  31.             SQL_FETCH_LAST
  32.             SQL_FETCH_PRIOR
  33.             SQL_FETCH_ABSOLUTE
  34.             SQL_FETCH_RELATIVE
  35.             SQL_FETCH_BOOKMARK
  36.  
  37.             SQL_COLUMN_COUNT
  38.             SQL_COLUMN_NAME
  39.             SQL_COLUMN_TYPE
  40.             SQL_COLUMN_LENGTH
  41.             SQL_COLUMN_PRECISION
  42.             SQL_COLUMN_SCALE
  43.             SQL_COLUMN_DISPLAY_SIZE
  44.             SQL_COLUMN_NULLABLE
  45.             SQL_COLUMN_UNSIGNED
  46.             SQL_COLUMN_MONEY
  47.             SQL_COLUMN_UPDATABLE
  48.             SQL_COLUMN_AUTO_INCREMENT
  49.             SQL_COLUMN_CASE_SENSITIVE
  50.             SQL_COLUMN_SEARCHABLE
  51.             SQL_COLUMN_TYPE_NAME
  52.             SQL_COLUMN_TABLE_NAME
  53.             SQL_COLUMN_OWNER_NAME
  54.             SQL_COLUMN_QUALIFIER_NAME
  55.             SQL_COLUMN_LABEL
  56.             SQL_COLATT_OPT_MAX
  57.             SQL_COLUMN_DRIVER_START
  58.             SQL_COLATT_OPT_MIN
  59.             SQL_ATTR_READONLY
  60.             SQL_ATTR_WRITE
  61.             SQL_ATTR_READWRITE_UNKNOWN
  62.             SQL_UNSEARCHABLE
  63.             SQL_LIKE_ONLY
  64.             SQL_ALL_EXCEPT_LIKE
  65.             SQL_SEARCHABLE
  66.         );
  67.  
  68.  
  69. sub new
  70. {
  71.     my ($n, $self);
  72.     my ($type) = shift;
  73.     my ($DSN) = shift;
  74.     my (@Results) = @_;
  75.  
  76.     if (ref $DSN){
  77.         @Results = ODBCClone($DSN->{'connection'});
  78.     }else{
  79.         @Results = ODBCConnect($DSN, @Results);
  80.     }
  81.     @Results = processError(-1, @Results);
  82.     if (! scalar(@Results)){
  83.         return undef;
  84.     }
  85.     $self = bless {};
  86.     $self->{'connection'} = $Results[0];
  87.     $ErrConn = $Results[0];
  88.     $ErrText = $Results[1];
  89.     $ErrNum = 0;
  90.     $self->{'DSN'} = $DSN;
  91.     $self;
  92. }
  93.  
  94. sub Close
  95. {
  96.     my ($self, $Result) = shift;
  97.     $Result = DESTROY($self);
  98.     $self->{'connection'} = -1;
  99.     return $Result;
  100. }
  101.  
  102. sub DESTROY
  103. {
  104.     my ($self) = shift;
  105.     my (@Results) = (0);
  106.     if($self->{'connection'} > -1){
  107.         @Results = ODBCDisconnect($self->{'connection'});
  108.         @Results = processError($self, @Results);
  109.         if ($Results[0]){
  110.             undef $self->{'DSN'};
  111.             undef @{$self->{'fnames'}};
  112.             undef %{$self->{'field'}};
  113.             undef %{$self->{'connection'}};
  114.         }
  115.     }
  116.     return $Results[0];
  117. }
  118.  
  119.  
  120. sub sql{
  121.     return (Sql(@_));
  122. }
  123.  
  124. sub Sql{
  125.     my ($self, $Sql, @Results) = @_;
  126.     @Results = ODBCExecute($self->{'connection'}, $Sql);
  127.     return updateResults($self, @Results);
  128. }
  129.  
  130. sub Data{
  131.  
  132.     my($self) = shift;
  133.     my(@Fields) = @_;
  134.     my(@Results, $Results, $Field);
  135.  
  136.     if ($self->{'Dirty'}){
  137.         GetData($self);
  138.         $self->{'Dirty'} = 0;
  139.     }
  140.     @Fields = @{$self->{'fnames'}} if (! scalar(@Fields));
  141.     foreach $Field (@Fields) {
  142.         if (wantarray) {
  143.             push(@Results, data($self, $Field));
  144.         } else {
  145.             $Results .= data($self, $Field);
  146.         }
  147.     }
  148.     return wantarray ? @Results : $Results;
  149. }
  150.  
  151. sub DataHash{
  152.     my($self, @Results) = @_;
  153.     my(%Results, $Element);
  154.  
  155.     if ($self->{'Dirty'}){
  156.         GetData($self);
  157.         $self->{'Dirty'} = 0;
  158.     }
  159.     @Results = @{$self->{'fnames'}} if (! scalar(@Results));
  160.     foreach $Element (@Results) {
  161.         $Results{$Element} = data($self, $Element);
  162.     }
  163.  
  164.     return %Results;
  165. }
  166.  
  167. sub data
  168. {  $_[0]->{'data'}->{$_[1]}; }
  169.  
  170.  
  171. sub fetchrow{
  172.     return (FetchRow(@_));
  173. }
  174. sub FetchRow{
  175.     my ($self, @Results) = @_;
  176.     my ($item, $num, $sqlcode);
  177.     $num = 0;
  178.     undef $self->{'data'};
  179.  
  180.  
  181.     @Results = ODBCFetch($self->{'connection'}, @Results);
  182.     if (! (@Results = processError($self, @Results))){
  183.         return undef;
  184.     }
  185.     $self->{'Dirty'} = 1;
  186.  
  187.     return @Results;
  188. }
  189.  
  190. sub GetData{
  191.     my($self) = @_;
  192.     my(@Results, $num);
  193.  
  194.     @Results = ODBCGetData($self->{'connection'});
  195.     if (!(@Results = processError($self, @Results))){
  196.         return undef;
  197.     }
  198.     ClearError();
  199.     foreach (@Results){
  200.         s/ +$//; # HACK
  201.         $self->{'data'}->{ ${$self->{'fnames'}}[$num] } = $_;
  202.         $num++;
  203.     }
  204.     return wantarray? (1, 1): 1;
  205. }
  206.  
  207. sub MoreResults{
  208.     my ($self) = @_;
  209.  
  210.     my(@Results) = ODBCMoreResults($self->{'connection'});
  211.     return (processError($self, @Results))[0];
  212. }
  213.  
  214. sub Catalog{
  215.     my ($self) = shift;
  216.     my ($Qualifier, $Owner, $Name, $Type) = @_;
  217.     my (@Results) = ODBCTableList($self->{'connection'}, $Qualifier, $Owner, $Name, $Type);
  218.  
  219.     return (updateResults($self, @Results) != 1);
  220. }
  221.  
  222. sub TableList{
  223.     my ($self) = shift;
  224.     my (@Results) = @_;
  225.     if (! scalar(@Results)){
  226.         @Results = ("", "", "%", "TABLE");
  227.     }
  228.  
  229.     if (! Catalog($self, @Results)){
  230.         return undef;
  231.     }
  232.     undef @Results;
  233.     while (FetchRow($self)){
  234.         push(@Results, Data($self, "TABLE_NAME"));
  235.     }
  236.     return sort(@Results);
  237. }
  238.  
  239.  
  240. sub fieldnames{
  241.     return (FieldNames(@_));
  242. }
  243. sub FieldNames { $self = shift; return @{$self->{'fnames'}}; }
  244.  
  245.  
  246. sub ShutDown{
  247.     my($self) = @_;
  248.     print "\nClosing connection $self->{'connection'}...";
  249.     $self->Close();
  250.     print "\nDone\n";
  251. }
  252.  
  253. sub Connection{
  254.     my($self) = @_;
  255.     return $self->{'connection'};
  256. }
  257.  
  258. sub GetConnections{
  259.     return ODBCGetConnections();
  260. }
  261.  
  262. sub SetMaxBufSize{
  263.     my($self, $Size) = @_;
  264.     my(@Results) = ODBCSetMaxBufSize($self->{'connection'}, $Size);
  265.     return (processError($self, @Results))[0];
  266. }
  267.  
  268. sub GetMaxBufSize{
  269.     my($self) = @_;
  270.     my(@Results) = ODBCGetMaxBufSize($self->{'connection'});
  271.     return (processError($self, @Results))[0];
  272. }
  273.  
  274.  
  275. sub GetDSN{
  276.     my($self, $DSN) = @_;
  277.     if(! ref($self)){
  278.         $DSN = $self;
  279.         $self = 0;
  280.     }
  281.     if (! $DSN){
  282.         $self = $self->{'connection'};
  283.     }
  284.     my(@Results) = ODBCGetDSN($self, $DSN);
  285.     return (processError($self, @Results));
  286. }
  287.  
  288. sub DataSources{
  289.     my($self, $DSN) = @_;
  290.     if(! ref $self){
  291.         $DSN = $self;
  292.         $self = 0;
  293.     }
  294.     my(@Results) = ODBCDataSources($DSN);
  295.     return (processError($self, @Results));
  296. }
  297.  
  298. sub Drivers{
  299.     my($self) = @_;
  300.     if(! ref $self){
  301.         $self = 0;
  302.     }
  303.     my(@Results) = ODBCDrivers();
  304.     return (processError($self, @Results));
  305. }
  306.  
  307. sub RowCount{
  308.     my($self, $Connection) = @_;
  309.     if (! ref($self)){
  310.         $Connection = $self;
  311.         $self = 0;
  312.     }
  313.     if (! $Connection){$Connection = $self->{'connection'};}
  314.     my(@Results) = ODBCRowCount($Connection);
  315.     return (processError($self, @Results))[0];
  316. }
  317.  
  318. sub GetStmtCloseType{
  319.     my($self, $Connection) = @_;
  320.     if (! ref($self)){
  321.         $Connection = $self;
  322.         $self = 0;
  323.     }
  324.     if (! $Connection){$Connection = $self->{'connection'};}
  325.     my(@Results) = ODBCGetStmtCloseType($Connection);
  326.     return (processError($self, @Results));
  327. }
  328.  
  329. sub SetStmtCloseType{
  330.     my($self, $Type, $Connection) = @_;
  331.     if (! ref($self)){
  332.         $Connection = $Type;
  333.         $Type = $self;
  334.         $self = 0;
  335.     }
  336.     if (! $Connection){$Connection = $self->{'connection'};}
  337.     my(@Results) = ODBCSetStmtCloseType($Connection, $Type);
  338.     return (processError($self, @Results))[0];
  339. }
  340.  
  341. sub ColAttributes{
  342.     my($self, $Type, @Field) = @_;
  343.     my(%Results, @Results, $Results, $Attrib, $Connection, $Temp);
  344.     if (! ref($self)){
  345.         $Type = $Field;
  346.         $Field = $self;
  347.         $self = 0;
  348.     }
  349.     $Connection = $self->{'connection'};
  350.     if (! scalar(@Field)){ @Field = $self->fieldnames;}
  351.     foreach $Temp (@Field){
  352.         @Results = ODBCColAttributes($Connection, $Temp, $Type);
  353.         ($Attrib) = processError($self, @Results);
  354.         if (wantarray){
  355.             $Results{$Temp} = $Attrib;
  356.         }else{
  357.             $Results .= "$Temp";
  358.         }
  359.     }
  360.     return wantarray? %Results:$Results;
  361. }
  362.  
  363. sub GetInfo{
  364.     my($self, $Type) = @_;
  365.     my($Connection, @Results);
  366.     if(! ref $self){
  367.         $Type = $self;
  368.         $self = 0;
  369.         $Connection = 0;
  370.     }else{
  371.         $Connection = $self->{'connection'};
  372.     }
  373.     @Results = ODBCGetInfo($Connection, $Type);
  374.     return (processError($self, @Results))[0];
  375. }
  376.  
  377. sub GetConnectOption{
  378.     my($self, $Type) = @_;
  379.     my(@Results);
  380.     if(! ref $self){
  381.         $Type = $self;
  382.         $self = 0;
  383.     }
  384.     @Results = ODBCGetConnectOption($self->{'connection'}, $Type);
  385.     return (processError($self, @Results))[0];
  386. }
  387.  
  388. sub SetConnectOption{
  389.     my($self, $Type, $Value) = @_;
  390.     if(! ref $self){
  391.         $Value = $Type;
  392.         $Type = $self;
  393.         $self = 0;
  394.     }
  395.     my(@Results) = ODBCSetConnectOption($self->{'connection'}, $Type, $Value);
  396.     return (processError($self, @Results))[0];
  397. }
  398.  
  399.  
  400. sub Transact{
  401.     my($self, $Type) = @_;
  402.     my(@Results);
  403.     if(! ref $self){
  404.         $Type = $self;
  405.         $self = 0;
  406.     }
  407.     @Results = ODBCTransact($self->{'connection'}, $Type);
  408.     return (processError($self, @Results))[0];
  409. }
  410.  
  411.  
  412. sub SetPos{
  413.     my($self, @Results) = @_;
  414.     @Results = ODBCSetPos($self->{'connection'}, @Results);
  415.     $self->{'Dirty'} = 1;
  416.     return (processError($self, @Results))[0];
  417. }
  418.  
  419. sub ConfigDSN{
  420.     my($self) = shift @_;
  421.     my($Type, $Connection);
  422.     if(! ref $self){
  423.         $Type = $self;
  424.         $Connection = 0;
  425.         $self = 0;
  426.     }else{
  427.         $Type = shift @_;
  428.         $Connection = $self->{'connection'};
  429.     }
  430.     my($Driver, @Attributes) = @_;
  431.     @Results = ODBCConfigDSN($Connection, $Type, $Driver, @Attributes);
  432.     return (processError($self, @Results))[0];
  433. }
  434.  
  435.  
  436. sub Version{
  437.     my($self, @Packages) = @_;
  438.     my($Temp, @Results);
  439.     if (! ref($self)){
  440.         push(@Packages, $self);
  441.     }
  442.     my($ExtName, $ExtVersion) = Info();
  443.     if (! scalar(@Packages)){
  444.         @Packages = ("ODBC.PM", "ODBC.PLL");
  445.     }
  446.     foreach $Temp (@Packages){
  447.         if ($Temp =~ /pll/i){
  448.             push(@Results, "ODBC.PM:$Win32::ODBC::Version");
  449.         }elsif ($Temp =~ /pm/i){
  450.             push(@Results, "ODBC.PLL:$ExtVersion");
  451.         }
  452.     }
  453.     return @Results;
  454. }
  455.  
  456.  
  457. sub SetStmtOption{
  458.     my($self, $Option, $Value) = @_;
  459.     if(! ref $self){
  460.         $Value = $Option;
  461.         $Option = $self;
  462.         $self = 0;
  463.     }
  464.     my(@Results) = ODBCSetStmtOption($self->{'connection'}, $Option, $Value);
  465.     return (processError($self, @Results))[0];
  466. }
  467.  
  468. sub GetStmtOption{
  469.     my($self, $Type) = @_;
  470.     if(! ref $self){
  471.         $Type = $self;
  472.         $self = 0;
  473.     }
  474.     my(@Results) = ODBCGetStmtOption($self->{'connection'}, $Type);
  475.     return (processError($self, @Results))[0];
  476. }
  477.  
  478. sub GetFunctions{
  479.     my($self, @Results)=@_;
  480.     @Results = ODBCGetFunctions($self->{'connection'}, @Results);
  481.     return (processError($self, @Results));
  482. }
  483.  
  484. sub DropCursor{
  485.     my($self) = @_;
  486.     my(@Results) = ODBCDropCursor($self->{'connection'});
  487.     return (processError($self, @Results))[0];
  488. }
  489.  
  490. sub SetCursorName{
  491.     my($self, $Name) = @_;
  492.     my(@Results) = ODBCSetCursorName($self->{'connection'}, $Name);
  493.     return (processError($self, @Results))[0];
  494. }
  495.  
  496. sub GetCursorName{
  497.     my($self) = @_;
  498.     my(@Results) = ODBCGetCursorName($self->{'connection'});
  499.     return (processError($self, @Results))[0];
  500. }
  501.  
  502. sub GetSQLState{
  503.     my($self) = @_;
  504.     my(@Results) = ODBCGetSQLState($self->{'connection'});
  505.     return (processError($self, @Results))[0];
  506. }
  507.  
  508.  
  509. sub updateResults{
  510.     my ($self, $Error, @Results) = @_;
  511.  
  512.     undef %{$self->{'field'}};
  513.  
  514.     ClearError($self);
  515.     if ($Error){
  516.         SetError($self, $Results[0], $Results[1]);
  517.         return ($Error);
  518.     }
  519.  
  520.     @{$self->{'fnames'}} = @Results;
  521.  
  522.     foreach (0..$#{$self->{'fnames'}}){
  523.         s/ +$//;
  524.         $self->{'field'}->{${$self->{'fnames'}}[$_]} = $_;
  525.     }
  526.     return undef;
  527. }
  528.  
  529.  
  530. sub Debug{
  531.     my($self, $iDebug, $File) = @_;
  532.     my(@Results);
  533.     if (! ref($self)){
  534.         if (defined $self){
  535.             $File = $iDebug;
  536.             $iDebug = $self;
  537.         }
  538.         $Connection = 0;
  539.         $self = 0;
  540.     }else{
  541.         $Connection = $self->{'connection'};
  542.     }
  543.     push(@Results, ($Connection, $iDebug));
  544.     push(@Results, $File) if ($File ne "");
  545.     @Results = ODBCDebug(@Results);
  546.     return (processError($self, @Results))[0];
  547. }
  548.  
  549. sub DumpData {
  550.     my($self) = @_; my($f, $goo);
  551.  
  552.     print "\nDumping Data for connection: $self->{'connection'}\n";
  553.     print "Error: \"";
  554.     print $self->Error();
  555.     print "\"\n";
  556.     if (! $self->Error()){
  557.        foreach $f ($self->FieldNames){
  558.             print $f . " ";
  559.             $goo .= "-" x length($f);
  560.             $goo .= " ";
  561.         }
  562.         print "\n$goo\n";
  563.         while ($self->FetchRow()){
  564.             foreach $f ($self->FieldNames){
  565.                 print $self->data($f) . " ";
  566.             }
  567.             print "\n";
  568.         }
  569.     }
  570. }
  571.  
  572. sub DumpError{
  573.     my($self) = @_;
  574.     my($ErrNum, $ErrText, $ErrConn);
  575.     my($Temp);
  576.  
  577.     print "\n---------- Error Report: ----------\n";
  578.     if (ref $self){
  579.         ($ErrNum, $ErrText, $ErrConn) = $self->Error();
  580.         ($Temp = $self->GetDSN()) =~ s/.*DSN=(.*?);.*/$1/i;
  581.         print "Errors for \"$Temp\" on connection " . $self->{'connection'} . ":\n";
  582.     }else{
  583.         ($ErrNum, $ErrText, $ErrConn) = Error();
  584.         print "Errors for the package:\n";
  585.     }
  586.  
  587.     print "Connection Number: $ErrConn\nError number: $ErrNum\nError message: \"$ErrText\"\n";
  588.     print "-----------------------------------\n";
  589.  
  590. }
  591.  
  592. sub Run{
  593.     my($self, $Sql) = @_;
  594.  
  595.     print "\nExcecuting connection $self->{'connection'}\nsql statement: \"$Sql\"\n";
  596.     $self->sql($Sql);
  597.     print "Error: \"";
  598.     print $self->error;
  599.     print "\"\n";
  600.     print "--------------------\n\n";
  601. }
  602.  
  603.  
  604. sub processError{
  605.     my($self, $Error, @Results) = @_;
  606.     if ($Error){
  607.         SetError($self, $Results[0], $Results[1]);
  608.         undef @Results;
  609.     }
  610.     return @Results;
  611. }
  612.  
  613. sub error{
  614.     return (Error(@_));
  615. }
  616.  
  617. sub Error{
  618.     my($self) = @_;
  619.     if(ref($self)){
  620.         if($self->{'ErrNum'}){
  621.             my($State) = ODBCGetSQLState($self->{'connection'});
  622.             return (wantarray)? ($self->{'ErrNum'}, $self->{'ErrText'}, $self->{'connection'}, $State) :"[$self->{'ErrNum'}] [$self->{'connection'}] [$State] \"$self->{'ErrText'}\"";
  623.         }
  624.     }elsif ($ErrNum){
  625.         return (wantarray)? ($ErrNum, $ErrText, $ErrConn):"[$ErrNum] [$ErrConn] \"$ErrText\"";
  626.     }
  627.     return undef
  628. }
  629.  
  630. sub SetError{
  631.     my($self, $Num, $Text, $Conn) = @_;
  632.     if (ref $self){
  633.         $self->{'ErrNum'} = $Num;
  634.         $self->{'ErrText'} = $Text;
  635.         $Conn = $self->{'connection'} if ! $Conn;
  636.     }
  637.     $ErrNum = $Num;
  638.     $ErrText = $Text;
  639.  
  640.  
  641.     $ErrConn = $Conn;
  642. }
  643.  
  644. sub ClearError{
  645.     my($self, $Num, $Text) = @_;
  646.     if (ref $self){
  647.         undef $self->{'ErrNum'};
  648.         undef $self->{'ErrText'};
  649.     }else{
  650.         undef $ErrConn;
  651.         undef $ErrNum;
  652.         undef $ErrText;
  653.     }
  654.     ODBCCleanError();
  655.     return 1;
  656. }
  657.  
  658.  
  659. sub GetError{
  660.     my($self, $Connection) = @_;
  661.     my(@Results);
  662.     if (! ref($self)){
  663.         $Connection = $self;
  664.         $self = 0;
  665.     }else{
  666.         if (! defined($Connection)){
  667.             $Connection = $self->{'connection'};
  668.         }
  669.     }
  670.  
  671.     @Results = ODBCGetError($Connection);
  672.     return @Results;
  673. }
  674.  
  675.  
  676.  
  677.  
  678.  
  679. sub AUTOLOAD {
  680.  
  681.     my($constname);
  682.     ($constname = $AUTOLOAD) =~ s/.*:://;
  683.     $!=0;
  684.     $val = constant($constname, @_ ? $_[0] : 0);
  685.  
  686.     if ($! != 0) {
  687.     if ($! =~ /Invalid/) {
  688.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  689.         goto &AutoLoader::AUTOLOAD;
  690.     }
  691.     else {
  692.  
  693.         $pack = 0;
  694.         ($pack,$file,$line) = caller;
  695.             print "Your vendor has not defined Win32::ODBC macro $constname, used in $file at line $line.";
  696.     }
  697.     }
  698.     eval "sub $AUTOLOAD { $val }";
  699.     goto &$AUTOLOAD;
  700. }
  701.  
  702.  
  703. END{
  704. }
  705.  
  706.  
  707. bootstrap Win32::ODBC;
  708.  
  709.  
  710.  
  711. 1;
  712. __END__
  713.  
  714.  
  715.  
  716.