home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / ext / DB2CLI / DB2CLI.pm.in < prev    next >
Text File  |  1995-10-20  |  11KB  |  378 lines
  1. package DB2CLI;
  2.  
  3. =head1 NAME
  4.  
  5. DB2CLI - Call Level Interface of DB2/x.
  6.  
  7. =head1 DESCRIPTION
  8.  
  9. This modules supports all CLI (Call Level Interface) calls of DB2 2.1,
  10. except for SQLBind*, SQLExtendedFetch, SQLParam*, SQLPutData and
  11. SQLSetParam.
  12.  
  13. =head2 CLI Functions
  14.  
  15. For a detailed description of the CLI functions, consult the CLI
  16. reference. Parameters are passed one-to-one, with exceptions from this
  17. rule noted below. Some functions have default values for trailing
  18. parameters. Consult the implementation (db2cli.xs) for details on
  19. default arguments.
  20.  
  21. Output (pointer) arguments expect an lvalue (variable).
  22.  
  23. String lengths are implicit, both in and out. Functions which return
  24. data with a length argument of type SQLINTEGER can pass at most 1MB.
  25.  
  26. Parameters cannot be bound. Instead they are passed as trailing
  27. arguments to SQLExecute|ExecDirect[2] (see below). Missing or "undef"
  28. parameters are passed as NULL. Output parameters of stored procedures
  29. are not supported.
  30.  
  31. =item SQLExecute|ExecDirect
  32.  
  33. expect one argument for each parameter. The data types are derived
  34. from the Perl data type. Integer values are passed as SQL_INTEGER,
  35. floating point values as SQL_DOUBLE and strings as SQL_CHAR.
  36.  
  37. =item SQLExecute2|ExecDirect2
  38.  
  39. expect three arguments for each parameter. The first is the C data
  40. type (ignored if the value is of integer or floating point type), the
  41. second is the SQL data type and the third is the value.
  42.  
  43. =item Result columns
  44.  
  45. cannot be bound. Get column data as SQL_C_CHAR strings by supplying
  46. lvalue arguments to SQLFetch, or use SQLGetData. NULL values assign
  47. "undef". When using SQLGetData, SQL_C_SHORT|LONG assign an integer
  48. value, SQL_C_FLOAT|DOUBLE a floating point value and all others a
  49. string.
  50.  
  51. =item SQLGet(EnvAttr|ConnectOption|StmtOption)
  52.  
  53. Use SQLGet(EnvAttr|ConnectOption|StmtOption)Long for integer
  54. attributes/options and SQLGet(EnvAttr|ConnectOption|StmtOption)Str for
  55. string attributes/options.
  56.  
  57. =item SQLGetInfo
  58.  
  59. Use SQLGetInfoShort for 16-bit integers, SQLGetInfoLong for 32-bit
  60. integers and masks and SQLGetInfoStr for strings. Or use SQLGetInfoStr
  61. for all and unpack the returned data.
  62.  
  63. =item SQLSet(EnvAttr|ConnectOption|StmtOption)
  64.  
  65. pass a string attribute/option if the argument is a string and an
  66. integer attribute/option otherwise.
  67.  
  68. =item Constants
  69.  
  70. All constants defined in sqlcli.h, sqlcli1.h and sqlext.h are
  71. available as parameterless functions (the usual way for xsubs). I
  72. strongly recommend "use strict 'subs'", since a mistyped upper case
  73. name without parentheses silently yields the name string instead of
  74. the expected integer value (even with -w).
  75.  
  76. =back
  77.  
  78. =head2 High-Level Functions
  79.  
  80. On error, all high-level functions display an error message and die
  81. with a stack trace.
  82.  
  83. =item $connRef = Connect DB2CLI $dbname, $userid=undef, $password=undef;
  84.  
  85. Initialize CLI (first call) and connect to database. Return a
  86. reference to the database connection instance (object).
  87.  
  88. =item $connRef->Transact $type=SQL_COMMIT
  89.  
  90. Perform transaction. Return $connRef.
  91.  
  92. =item $connRef->Disconnect
  93.  
  94. Disconnect from database and deinitialize CLI (last call). $connRef is
  95. set to undef.
  96.  
  97. =item $stmtRef = $connRef->Statement [$comment]
  98.  
  99. Create a statement instance. Returns a reference to the instance.
  100. $comment is displayed in error messages.
  101.  
  102. =item $rc = $connRef->ExecDirect $sqlstmt, @args
  103.  
  104. Shorthand for Statement+Execute+Release. Pass the return code of
  105. SQLExecute.
  106.  
  107. =item $rc = $stmtRef->Prepare $sqlstmt, [$stmtRef2]
  108.  
  109. Prepares a SQL statement. If $stmtRef2 is given, append the name of
  110. its cursor to the SQL statement text - in this case the SQL statement
  111. should end in "WHERE CURRENT OF". Returns $stmtRef.
  112.  
  113. =item $rc = $stmtRef->Execute @args
  114.  
  115. Execute the prepared statement, optionally passing the given
  116. arguments. Pass the return code of SQLExecute.
  117.  
  118. =item $rc = $stmtRef->Fetch @cols
  119.  
  120. Fetch the next row into @cols (list of lvalues). Pass the return code
  121. of SQLFetch.
  122.  
  123. =item $stmtRef->Close
  124.  
  125. Release resources and locks associated with a prepared
  126. statement. Return $stmtRef.
  127.  
  128. =item $stmtRef->Release
  129.  
  130. Like Close, but release the statement instance too. Always returns
  131. undef.
  132.  
  133. =item $anyRef->Message [$text]
  134.  
  135. Display available information about the last error associated with the
  136. connection or statement instance. Transactions are rolled back. The
  137. script is terminated by calling `confess' (see Carp.pm) with $text as
  138. argument.
  139.  
  140. =item $connRef->{HENV}, $connRef->{HDBC}, $stmtRef->{HSTMT}
  141.  
  142. Environment, connection and statement handle of connection or
  143. statement instance.
  144.  
  145. =back
  146.  
  147. =head2 EXAMPLE
  148.  
  149.      use DB2CLI;
  150.      use strict 'subs';
  151.      
  152.      die "Usage: runstats <database> <schema>\n"
  153.          if $#ARGV < 1;
  154.      $database = uc shift @ARGV;
  155.      $schema   = uc shift @ARGV;
  156.      
  157.      $dbc = Connect DB2CLI $database, undef, undef;
  158.      $stmt = $dbc->Statement("Select tables of schema $schema");
  159.      
  160.      $rc = SQLTables($stmt->{HSTMT}, "", $schema, "%", "")
  161.          and $stmt->Message("SQLTables", $rc);
  162.      
  163.      while (($rc = $stmt->Fetch($cat, $sch, $tab, $typ, $rem)) == 0) {
  164.          print "runstats on table $sch.$tab with distribution and detailed indexes all\n";
  165.      }
  166.      
  167.      $stmt->Release();
  168.      $dbc->Disconnect();
  169.  
  170. =cut
  171.  
  172. use Carp;
  173. require Exporter;
  174. require DynaLoader;
  175. require AutoLoader;
  176.  
  177. @ISA = qw(Exporter DynaLoader);
  178. # Items to export into callers namespace by default. Note: do not export
  179. # names by default without a very good reason. Use EXPORT_OK instead.
  180. # Do not simply export all your public functions/methods/constants.
  181. @EXPORT = qw(
  182. %%
  183. );
  184. sub AUTOLOAD {
  185.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  186.     # XS function.  If a constant is not found then control is passed
  187.     # to the AUTOLOAD in AutoLoader.
  188.  
  189.     local($constname);
  190.     ($constname = $AUTOLOAD) =~ s/.*:://;
  191.     $val = constant($constname, @_ ? $_[0] : 0);
  192.     if ($! != 0) {
  193.     if ($! =~ /Invalid/) {
  194.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  195.         goto &AutoLoader::AUTOLOAD;
  196.     }
  197.     else {
  198.         ($pack,$file,$line) = caller;
  199.         die "Your vendor has not defined DB2CLI macro $constname, used at $file line $line.
  200. ";
  201.     }
  202.     }
  203.     eval "sub $AUTOLOAD { $val }";
  204.     goto &$AUTOLOAD;
  205. }
  206.  
  207. bootstrap DB2CLI;
  208.  
  209. # Preloaded methods go here.
  210.  
  211. # Autoload methods go after __END__, and are processed by the autosplit program.
  212.  
  213. 1;
  214. __END__
  215. #############################################################################
  216.  
  217. sub iMessage
  218. {
  219.     my ($henv, $hdbc, $hstmt, $where, $failrc) = @_;
  220.     my ($state, $code, $message, $text);
  221.     my $rc = SQLError($henv, $hdbc, $hstmt, $state, $code, $message);
  222.     $text = "\n$where";
  223.     $text .= "\n\trc=$failrc"
  224.     if $failrc;
  225.     $text .= "\nCannot obtain SQL error message, API rc=$rc:\n"
  226.     if $rc < 0;
  227.     $text .= ", state=$state, code=$code\n$message\n\n";
  228.     if ($failrc >= 0) {
  229.     croak $text;
  230.     return 1;
  231.     }
  232.     SQLTransact($hdbc, SQL_ROLLBACK);
  233.     confess $text;
  234. }
  235.  
  236. #############################################################################
  237. # Connections
  238.  
  239. sub Connect
  240. {
  241.     my ($class, $database, $user, $pw) = @_;
  242.     my ($henv, $hdbc, $rc);
  243.     if ($rc = SQLAllocEnv($henv)) {
  244.     warn "SQLAllocEnv failed with rc=$rc\n";
  245.     return undef;
  246.     }
  247.     if ($rc = SQLAllocConnect($henv, $hdbc)) {
  248.     iMessage($henv, undef, undef, "SQLAllocConnect", $rc);
  249.     SQLFreeEnv($henv);
  250.     return undef;
  251.     }
  252.     my $connRef = bless { HENV => $henv, HDBC => $hdbc, DATABASE => $database };
  253.     if ($rc = SQLConnect($hdbc, $database, $user, $pw)) {
  254.     $connRef->Message("SQLConnect to $database", $rc);
  255.     SQLFreeConnect($hdbc);
  256.     SQLFreeEnv($henv);
  257.     return undef;
  258.     }
  259.     return $connRef;
  260. }
  261.  
  262. sub Transact
  263. {
  264.     my ($connRef, $arg) = @_;
  265.     my ($rc);
  266.     if ($rc = SQLTransact($connRef->{HDBC}, $arg)) {
  267.     $connRef->Message("SQLTransact $connRef->{DATABASE}", $rc);
  268.     }
  269.     return $connRef;
  270. }
  271.  
  272. sub Disconnect
  273. {
  274.     my ($connRef) = @_;
  275.     my ($rc);
  276.     if ($rc = SQLDisconnect($connRef->{HDBC})) {
  277.     $connRef->Message("SQLDisconnect from $connRef->{DATABASE}", $rc);
  278.     }
  279.     SQLFreeConnect($connRef->{HDBC});
  280.     SQLFreeEnv($connRef->{HDBC});
  281.     return $_[0] = undef;
  282. }
  283.  
  284. #############################################################################
  285. # Statements
  286.  
  287. sub Statement
  288. {
  289.     my ($connRef, $comment) = @_;
  290.     my ($hstmt, $rc);
  291.     if ($rc = SQLAllocStmt($connRef->{HDBC}, $hstmt)) {
  292.     $connRef->Message("SQLAllocStmt", $rc);
  293.     return undef;
  294.     }
  295.     return bless { %$connRef, HSTMT => $hstmt, TEXT => $comment };
  296. }
  297.  
  298. sub ExecDirect
  299. {
  300.     my ($connRef, $stmt, @args) = @_;
  301.     my $stmtRef = $connRef->Prepare($stmt);
  302.     my $rc = $stmtRef->Execute(@args);
  303.     $stmtRef->Release();
  304.     return $rc;
  305. }
  306.  
  307. sub Prepare
  308. {
  309.     my ($connRef, $stmt, $refStmt) = @_;
  310.     my ($hstmt, $rc);
  311.     if ($rc = SQLAllocStmt($connRef->{HDBC}, $hstmt)) {
  312.     $connRef->Message("SQLAllocStmt", $rc);
  313.     return undef;
  314.     }
  315.     if ($refStmt) {
  316.     my $cursor = "-Unknown-";
  317.     SQLGetCursorName($refStmt->{HSTMT}, $cursor);
  318.     $stmt .= " $cursor";
  319.     }
  320.     my $i = index($stmt, "\n", 1);
  321.     my $s = ($i >= 0) ? substr($stmt, 0, $i) : $stmt;
  322.     my $stmtRef = bless { %$connRef, HSTMT => $hstmt, TEXT => $s };
  323.     if ($rc = SQLPrepare($hstmt, $stmt)) {
  324.     $stmtRef->Message("SQLPrepare \"$s\"", $rc);
  325.     return undef;
  326.     }
  327.     return $stmtRef;
  328. }
  329.  
  330. sub Execute
  331. {
  332.     my ($stmtRef) = shift @_;
  333.     my ($rc);
  334.     if ($rc = SQLExecute($stmtRef->{HSTMT}, @_)) {
  335.     $stmtRef->Message("SQLExecute \"$stmtRef->{TEXT}\"", $rc);
  336.     }
  337.     return $rc;
  338. }
  339.  
  340. sub Fetch
  341. {
  342.     my ($stmtRef) = shift @_;
  343.     my ($rc);
  344.     if (($rc = SQLFetch($stmtRef->{HSTMT}, @_)) != SQL_SUCCESS && $rc != SQL_NO_DATA) {
  345.     $stmtRef->Message("SQLFetch \"$stmtRef->{TEXT}\"", $rc);
  346.     }
  347.     return $rc;
  348. }
  349.  
  350. sub Close
  351. {
  352.     my ($stmtRef) = @_;
  353.     my ($rc);
  354.     if ($rc = SQLFreeStmt($stmtRef->{HSTMT}, SQL_CLOSE)) {
  355.     $stmtRef->Message("SQLFreeStmt \"$stmtRef->{TEXT}\"", $rc);
  356.     }
  357.     return $stmtRef;
  358. }
  359.  
  360. sub Release
  361. {
  362.     my ($stmtRef) = @_;
  363.     my ($rc);
  364.     if ($rc = SQLFreeStmt($stmtRef->{HSTMT})) {
  365.     $stmtRef->Message("SQLFreeStmt \"$stmtRef->{TEXT}\"", $rc);
  366.     }
  367.     return undef;
  368. }
  369.  
  370. sub Message
  371. {
  372.     my ($stmtRef, $text, $rc) = @_;
  373.     iMessage($stmtRef->{HENV}, $stmtRef->{HDBC},
  374.          exists($stmtRef->{HSTMT}) ? $stmtRef->{HSTMT} : undef,
  375.          $text, $rc);
  376.     die if $rc < 0;
  377. }
  378.