home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _8e8fed286737c6fc57b412fb16a0f4c7 < prev    next >
Text File  |  2000-03-15  |  17KB  |  479 lines
  1. #####
  2. #       T E S T . P L
  3. #       -------------
  4. #       A test script for exercising the Win32::ODBC extension. Install
  5. #       the ODBC.PLL extension and the ODBC.PM wrapper, set up an ODBC
  6. #       DSN (Data Source Name) by the ODBC administrator, then give this a try!
  7. #
  8. #       READ THE DOCUMENTATION -- I AM NOT RESPOSIBLE FOR ANY PROBLEMS THAT
  9. #       THIS MAY CAUSE WHATSOEVER.  BY USING THIS OR ANY  ---
  10. #       OF THE WIN32::ODBC PARTS FOUND IN THE DISTRIBUTION YOU ARE AGREEING
  11. #       WITH THE TERMS OF THIS DISTRIBUTION!!!!!
  12. #
  13. #
  14. #       You have been warned.
  15. #       --- ---- ---- ------
  16. #
  17. #       Updated to test newest version v961007.  Dave Roth <rothd@roth.net>
  18. #           This version contains a small sample database (in MS Access 7.0
  19. #           format) called ODBCTest.mdb. Place this database in the same
  20. #           directory as this test.pl file.
  21. #
  22. #       --------------------------------------------------------------------
  23. #
  24. #       SYNTAX:
  25. #           perl test.pl ["DSN Name" [Max Rows]]
  26. #
  27. #               DSN Name....Name of DSN that will be used. If this is
  28. #                           omitted then we will use the obnoxious default DSN.
  29. #               Max Rows....Maximum number of rows wanted to be retrieved from
  30. #                           the DSN.
  31. #                           - If this is 0 then the request is to retrieve as
  32. #                             many as possible.
  33. #                           - If this is a value greater than that which the DSN
  34. #                             driver can handle the value will be the greatest
  35. #                             the DSN driver allows.
  36. #                           - If omitted then we use the default value.
  37. #####
  38.  
  39.     use Win32::ODBC;
  40.  
  41.  
  42.     $TempDSN = "Win32 ODBC Test --123xxYYzz987--";
  43.     $iTempDSN = 1;
  44.  
  45.     if (!($DSN = $ARGV[0])){
  46.         $DSN = $TempDSN;
  47.     }
  48.     $MaxRows = 8 unless defined ($MaxRows = $ARGV[1]);
  49.  
  50.     $DriverType = "Microsoft Access Driver (*.mdb)";
  51.     $Desc = "Description=The Win32::ODBC Test DSN for Perl";
  52.     $Dir = `cd`;
  53.     chop $Dir;
  54.     $DBase = "ODBCTest.mdb";
  55.  
  56.     $iWidth=60;
  57.     %SQLStmtTypes = (SQL_CLOSE, "SQL_CLOSE", SQL_DROP, "SQL_DROP", SQL_UNBIND, "SQL_UNBIND", SQL_RESET_PARAMS, "SQL_RESET_PARAMS");
  58.  
  59. #    Initialize();
  60.  
  61.     ($Name, $Version, $Date, $Author, $CompileDate, $CompileTime, $Credits) = Win32::ODBC::Info();
  62.     print "\n";
  63.     print "\t+", "=" x ($iWidth), "+\n";
  64.     print "\t|", Center("", $iWidth), "|\n";
  65.     print "\t|", Center("", $iWidth), "|\n";
  66.     print "\t|", Center("$Name", $iWidth), "|\n";
  67.     print "\t|", Center("-" x length("$Name"), $iWidth), "|\n";
  68.     print "\t|", Center("", $iWidth), "|\n";
  69.  
  70.     print "\t|", Center("Version $Version ($Date)", $iWidth), "|\n";
  71.     print "\t|", Center("by $Author", $iWidth), "|\n";
  72.     print "\t|", Center("Compiled on $CompileDate at $CompileTime.", $iWidth), "|\n";
  73.     print "\t|", Center("", $iWidth), "|\n";
  74.     print "\t|", Center("Credits:", $iWidth), "|\n";
  75.     print "\t|", Center(("-" x length("Credits:")), $iWidth), "|\n";
  76.     foreach $Temp (split("\n", $Credits)){
  77.         print "\t|", Center("$Temp", $iWidth), "|\n";
  78.     }
  79.     print "\t|", Center("", $iWidth), "|\n";
  80.     print "\t+", "=" x ($iWidth), "+\n";
  81.  
  82. ####
  83. #   T E S T  1
  84. ####
  85.     PrintTest(1, "Dump available ODBC Drivers");
  86.     print "\nAvailable ODBC Drivers:\n";
  87.     if (!(%Drivers = Win32::ODBC::Drivers())){
  88.         $Failed{'Test 1'} = "Drivers(): " . Win32::ODBC::Error();
  89.     }
  90.     foreach $Driver (keys(%Drivers)){
  91.         print "  Driver=\"$Driver\"\n  Attributes: ", join("\n" . " "x14, sort(split(';', $Drivers{$Driver}))), "\n\n";
  92.     }
  93.  
  94.  
  95. ####
  96. #   T E S T  2
  97. ####
  98.     PrintTest(2,"Dump available datasources");
  99.  
  100.     ####
  101.     #   Notice you don't need an instantiated object to use this...
  102.     ####
  103.     print "\nHere are the available datasources...\n";
  104.     if (!(%DSNs = Win32::ODBC::DataSources())){
  105.         $Failed{'Test 2'} = "DataSources(): " . Win32::ODBC::Error();
  106.     }
  107.     foreach $Temp (keys(%DSNs)){
  108.         if (($Temp eq $TempDSN) && ($DSNs{$Temp} eq $DriverType)){
  109.             $iTempDSNExists++;
  110.         }
  111.         if ($DSN =~ /$Temp/i){
  112.             $iTempDSN = 0;
  113.             $DriverType = $DSNs{$Temp};
  114.         }
  115.         print "\tDSN=\"$Temp\" (\"$DSNs{$Temp}\")\n";
  116.     }
  117.  
  118. ####
  119. #   T E S T 2.5
  120. ####
  121.         #   IF WE DO NOT find the DSN the user specified...
  122.     if ($iTempDSN){
  123.         PrintTest("2.5", "Create a Temporary DSN");
  124.  
  125.         print "\n\tCould not find the DSN (\"$DSN\") so we will\n\tuse a temporary one (\"$TempDSN\")...\n\n";
  126.  
  127.         $DSN = $TempDSN;
  128.  
  129.         if (! $iTempDSNExists){
  130.             print "\tAdding DSN \"$DSN\"...";
  131.             if (Win32::ODBC::ConfigDSN(ODBC_ADD_DSN, $DriverType, ("DSN=$DSN", "Description=The Win32 ODBC Test DSN for Perl", "DBQ=$Dir\\$DBase", "DEFAULTDIR=$Dir", "UID=", "PWD="))){
  132.                 print "Successful!\n";
  133.             }else{
  134.                 print "Failure\n";
  135.                 $Failed{'Test 2.5'} = "ConfigDSN(): Could not add \"$DSN\": " . Win32::ODBC::Error();
  136.                     # If we failed here then use the last DSN we listed in Test 2
  137.                 $DriverType = $DSNs{$Temp};
  138.                 $DSN = $Temp;
  139.                 print "\n\tCould not add a temporary DSN so using the last one listed:\n";
  140.                 print "\t\t$DSN ($DriverType)\n";
  141.  
  142.             }
  143.         }
  144.     }
  145.  
  146. ####
  147. #   Report What Driver/DSN we are using
  148. ####
  149.  
  150.     print "\n\nWe are using the DSN:\n\tDSN = \"$DSN\"\n";
  151.     print "\tDriver = \"$DriverType\"\n\n";
  152.  
  153.  
  154. ####
  155. #   T E S T  3
  156. ####
  157.     PrintTest(3, "Open several ODBC connections");
  158.     print "\n\tOpening ODBC connection for \"$DSN\"...\n\t\t";
  159.     if (!($O = new Win32::ODBC($DSN))){
  160.         print "Failure. \n\n";
  161.         $Failed{'Test 3a'} = "new(): " . Win32::ODBC::Error();
  162.         PresentErrors();
  163.         exit();
  164.     }else{
  165.         print "Success (connection #", $O->Connection(), ")\n\n";
  166.     }
  167.  
  168.     print "\tOpening ODBC connection for \"$DSN\"...\n\t\t";
  169.     if (!($O2 = new Win32::ODBC($DSN))){
  170.         $Failed{'Test 3b'} = "new(): " . Win32::ODBC::Error();
  171.         print "Failure. \n\n";
  172.     }else{
  173.         print "Success (connection #", $O2->Connection(), ")\n\n";
  174.     }
  175.  
  176.     print "\tOpening ODBC connection for \"$DSN\"\n\t\t";
  177.     if (!($O3 = new Win32::ODBC($DSN))){
  178.         $Failed{'Test 3c'} = "new(): " . Win32::ODBC::Error();
  179.         print "Failure. \n\n";
  180.     }else{
  181.         print "Success (connection #", $O3->Connection(), ")\n\n";
  182.     }
  183.  
  184.  
  185. ####
  186. #   T E S T  4
  187. ####
  188.     PrintTest(4, "Close all but one connection");
  189.  
  190.     print "\n\tCurrently open ODBC connections are: \"", join(", ", sort($O2->GetConnections())), "\"\n";
  191.     print "\tClosing ODBC connection #", $O2->Connection(), "...\n";
  192.     print "\t\t...", (($O2->Close())? "Successful.":"Failure."), "\n";
  193.  
  194.     print "\n\tCurrently open ODBC connections are: \"", join(", ", sort($O3->GetConnections())), "\"\n";
  195.     print "\tClosing ODBC connection #", $O3->Connection(), "...\n";
  196.     print "\t\t...", (($O3->Close())? "Successful.":"Failure."), "\n";
  197.  
  198.     print "\n\tCurrently open ODBC connections are: \"", join(", ", sort($O2->GetConnections())), "\"\n";
  199.  
  200. ####
  201. #   T E S T  5
  202. ####
  203.     PrintTest(5, "Set/query Max Buffer size for a connection");
  204.  
  205.     srand(time);
  206.     $Temp = int(rand(10240)) + 10240;
  207.     print "\nMaximum Buffer Size for connection #", $O->Connection(), ":\n";
  208.     print "\tValue set at ", $O->GetMaxBufSize(), "\n";
  209.  
  210.     print "\tSetting Maximum Buffer Size to $Temp...  it has been set to ", $O->SetMaxBufSize($Temp), "\n";
  211.     print "\tValue set at ", $O->GetMaxBufSize(), "\n";
  212.  
  213.     $Temp += int(rand(10240)) + 102400;
  214.     print "\tSetting Maximum Buffer Size to $Temp... (can not be more than 102400)\n\t\t...it has been set to ", $O->SetMaxBufSize($Temp), "\n";
  215.     print "\tValue set at ", $O->GetMaxBufSize(), "\n";
  216.  
  217.     $Temp = int(rand(1024)) + 2048;
  218.     print "\tSetting Maximum Buffer Size to $Temp...  it has been set to ", $O->SetMaxBufSize($Temp), "\n";
  219.  
  220.     print "\tValue set at ", $O->GetMaxBufSize(), "\n";
  221.  
  222.  
  223. ####
  224. #   T E S T  6
  225. ####
  226.     PrintTest(6, "Set/query Stmt Close Type");
  227.  
  228.     print "\n\tStatement Close Type is currently set as ", $O->GetStmtCloseType(), " " . $O->Error . "\n";
  229.     print "\tSetting Statement Close Type to SQL_CLOSE: (returned code of ",  $O->SetStmtCloseType(SQL_CLOSE), ")" . $O->Error . "\n";
  230.     print "\tStatement Close Type is currently set as ", $O->GetStmtCloseType(), " " . $O->Error ."\n";
  231.  
  232.  
  233. ####
  234. #   T E S T  7
  235. ####
  236.     PrintTest(7, "Dump DSN for current connection");
  237.  
  238.     if (! (%DSNAttributes = $O->GetDSN())){
  239.         $Failed{'Test 7'} = "GetDSN(): " . $O->Error();
  240.     }else{
  241.         print"\nThe DSN for connection #", $O->Connection(), ":\n";
  242.         print "\tDSN...\n";
  243.         foreach (sort(keys(%DSNAttributes))){
  244.             print "\t$_ = \"$DSNAttributes{$_}\"\n";
  245.         }
  246.     }
  247.  
  248.  
  249.  
  250. ####
  251. #   T E S T  8
  252. ####
  253.     PrintTest(8, "Dump list of ALL tables in datasource");
  254.  
  255.     print "\nList of tables for \"$DSN\"\n\n";
  256.     $Num = 0;
  257.     if ($O->Catalog("", "", "%", "'TABLE','VIEW','SYSTEM TABLE', 'GLOBAL TEMPORARY','LOCAL TEMPORARY','ALIAS','SYNONYM'")){
  258.  
  259.         print "\tCursor is currently named \"", $O->GetCursorName(), "\".\n";
  260.         print "\tRenaming cursor to \"TestCursor\"...", (($O->SetCursorName("TestCursor"))? "Success":"Failure"), ".\n";
  261.         print "\tCursor is currently named \"", $O->GetCursorName(), "\".\n\n";
  262.  
  263.         @FieldNames = $O->FieldNames();
  264.  
  265.         $~ = "Test_8_Header";
  266.         write;
  267.  
  268.         $~ = "Test_8_Body";
  269.         while($O->FetchRow()){
  270.             undef %Data;
  271.             %Data = $O->DataHash();
  272.             write;
  273.         }
  274.     }
  275.     print "\n\tTotal number of tables displayed: $Num\n";
  276.  
  277.  
  278.  
  279. ####
  280. #   T E S T  9
  281. ####
  282.     PrintTest(9, "Dump list of non-system tables and views in datasource");
  283.  
  284.     print "\n";
  285.     $Num = 0;
  286.  
  287.     foreach  $Temp ($O->TableList("", "", "%", "TABLE, VIEW, SYSTEM_TABLE")){
  288.         $Table = $Temp;
  289.         print "\t", ++$Num, ".) \"$Temp\"\n";
  290.     }
  291.     print "\n\tTotal number of tables displayed: $Num\n";
  292.  
  293.  
  294. ####
  295. #   T E S T  10
  296. ####
  297.     PrintTest(10, "Dump contents of the table: \"$Table\"");
  298.  
  299.     print "\n";
  300.  
  301.     print "\tResetting (dropping) cursor...", (($O->DropCursor())? "Successful":"Failure"), ".\n\n";
  302.  
  303.     print "\tCurrently the cursor type is: ", $O->GetStmtOption($O->SQL_CURSOR_TYPE), "\n";
  304.     print "\tSetting Cursor to Dynamic (", ($O->SQL_CURSOR_DYNAMIC), ")...", (($O->SetStmtOption($O->SQL_CURSOR_TYPE, $O->SQL_CURSOR_DYNAMIC))? "Success":"Failure"), ".\n";
  305.     print "\t\tThis may have failed depending on your ODBC Driver.\n";
  306.     print "\t\tThis is not really a problem, it will default to another value.\n";
  307.     print "\tUsing the cursor type of: ", $O->GetStmtOption($O->SQL_CURSOR_TYPE), "\n\n";
  308.  
  309.     print "\tSetting the connection to only grab $MaxRows row", ($MaxRows == 1)? "":"s", " maximum...";
  310.     if ($O->SetStmtOption($O->SQL_MAX_ROWS, $MaxRows)){
  311.         print "Success!\n";
  312.     }else{
  313.         $Failed{'Test 10a'} = "SetStmtOption(): " . Win32::ODBC::Error();
  314.         print "Failure.\n";
  315.     }
  316.  
  317.     $iTemp = $O->GetStmtOption($O->SQL_MAX_ROWS);
  318.     print "\tUsing the maximum rows: ", (($iTemp)? $iTemp:"No maximum limit"), "\n\n";
  319.  
  320.     print "\tCursor is currently named \"", $O->GetCursorName(), "\".\n";
  321.     print "\tRenaming cursor to \"TestCursor\"...", (($O->SetCursorName("TestCursor"))? "Success":"Failure"), ".\n";
  322.     print "\tCursor is currently named \"", $O->GetCursorName(), "\".\n\n";
  323.  
  324.     if (! $O->Sql("SELECT * FROM [$Table]")){
  325.         @FieldNames = $O->FieldNames();
  326.         $Cols = $#FieldNames + 1;
  327.         $Cols = 8 if ($Cols > 8);
  328.  
  329.         $FmH = "format Test_10_Header =\n";
  330.         $FmH2 = "";
  331.         $FmH3 = "";
  332.         $FmB = "format Test_10_Body = \n";
  333.         $FmB2 = "";
  334.  
  335.         for ($iTemp = 0; $iTemp < $Cols; $iTemp++){
  336.             $FmH .= "@" . "<" x (80/$Cols - 2) . " ";
  337.             $FmH2 .= "\$FieldNames[$iTemp],";
  338.             $FmH3 .= "-" x (80/$Cols - 1) . " ";
  339.  
  340.             $FmB .= "@" . "<" x (80/$Cols - 2) . " ";
  341.             $FmB2 .= "\$Data{\$FieldNames[$iTemp]},";
  342.         }
  343.         chop $FmH2;
  344.         chop $FmB2;
  345.  
  346.         eval"$FmH\n$FmH2\n$FmH3\n.\n";
  347.         eval "$FmB\n$FmB2\n.\n";
  348.  
  349.         $~ = "Test_10_Header";
  350.         write();
  351.         $~ = "Test_10_Body";
  352.  
  353.             # Fetch the next rowset
  354.         while($O->FetchRow()){
  355.             undef %Data;
  356.             %Data = $O->DataHash();
  357.             write();
  358.         }
  359.             ####
  360.             #   THE preceeding block could have been written like this:
  361.             #   ------------------------------------------------------
  362.             #
  363.             #       print "\tCurrently the cursor type is: ", $O->GetStmtOption($O->SQL_CURSOR_TYPE), "\n";
  364.             #       print "\tSetting Cursor to Dynamic (", ($O->SQL_CURSOR_DYNAMIC), ")...", (($O->SetStmtOption($O->SQL_CURSOR_TYPE, $O->SQL_CURSOR_DYNAMIC))? "Success":"Failure"), ".\n";
  365.             #       print "\t\tThis may have failed depending on your ODBC Driver. No real problem.\n";
  366.             #       print "\tUsing the cursor type of: ", $O->GetStmtOption($O->SQL_CURSOR_TYPE), "\n\n";
  367.             #
  368.             #       print "\tSetting rowset size = 15 ...", (($O->SetStmtOption($O->SQL_ROWSET_SIZE, 15))? "Success":"Failure"), ".\n";
  369.             #       print "\tGetting rowset size: ", $O->GetStmtOption($O->SQL_ROWSET_SIZE), "\n\n";
  370.             #
  371.             #       while($O->FetchRow()){
  372.             #           $iNum = 1;
  373.             #               #  Position yourself in the rowset
  374.             #           while($O->SetPos($iNum++ ,$O->SQL_POSITION, $O->SQL_LOCK_NO_CHANGE)){
  375.             #               undef %Data;
  376.             #               %Data = $O->DataHash();
  377.             #               write();
  378.             #           }
  379.             #           print "\t\tNext rowset...\n";
  380.             #       }
  381.             #
  382.             #   The reason I didn't write it that way (which is easier) is to
  383.             #   show that we can now SetPos(). Also Fetch() now uses
  384.             #   SQLExtendedFetch() so it can position itself and retrieve
  385.             #   rowsets. Notice earlier in this Test 10 we set the
  386.             #   SQL_ROWSET_SIZE. If this was not set it would default to
  387.             #   no limit (depending upon your ODBC Driver).
  388.             ####
  389.  
  390.         print "\n\tNo more records available.\n";
  391.     }else{
  392.         $Failed{'Test 10'} = "Sql(): " . $O->Error();
  393.     }
  394.  
  395.     $O->Close();
  396.  
  397. ####
  398. #   T E S T 11
  399. ####
  400.     if ($iTempDSN){
  401.         PrintTest(11, "Remove the temporary DSN");
  402.         print "\n\tRemoving the temporary DSN:\n";
  403.         print "\t\tDSN = \"$DSN\"\n\t\tDriver = \"$DriverType\"\n";
  404.  
  405.         if (Win32::ODBC::ConfigDSN(ODBC_REMOVE_DSN, $DriverType, "DSN=$DSN")){
  406.             print "\tSuccessful!\n";
  407.         }else{
  408.             print "\tFailed.\n";
  409.             $Failed{'Test 11'} = "ConfigDSN(): Could not remove \"$DSN\":" . Win32::ODBC::Error();
  410.         }
  411.     }
  412.  
  413.  
  414.     PrintTest("E N D   O F   T E S T");
  415.     PresentErrors();
  416.  
  417.  
  418.  
  419. #----------------------- F U N C T I O N S ---------------------------
  420.  
  421. sub Error{
  422.     my($Data) = @_;
  423.     $Data->DumpError() if ref($Data);
  424.     Win32::ODBC::DumpError() if ! ref($Data);
  425. }
  426.  
  427.  
  428. sub Center{
  429.     local($Temp, $Width) = @_;
  430.     local($Len) = ($Width - length($Temp)) / 2;
  431.     return " " x int($Len), $Temp, " " x (int($Len) + (($Len != int($Len))? 1:0));
  432. }
  433.  
  434. sub PrintTest{
  435.     my($Num, $String) = @_;
  436.     my($Temp);
  437.     if (length($String)){
  438.         $Temp = "  T E S T  $Num $String ";
  439.     }else{
  440.         $Temp = "  $Num  ";
  441.     }
  442.     $Len = length($Temp);
  443.     print "\n", "-" x ((79 - $Len)/2), $Temp, "-" x ((79 - $Len)/2 - 1), "\n";
  444.     print "\t$String\n";
  445. }
  446.  
  447. sub PresentErrors{
  448.     PrintTest("", "Error Report:");
  449.     if (keys(%Failed)){
  450.         print "The following were errors:\n";
  451.         foreach (sort(keys(%Failed))){
  452.             print "$_ = $Failed{$_}\n";
  453.         }
  454.     }else{
  455.         print "\n\nThere were no errors reported during this test.\n\n";
  456.     }
  457. }
  458.  
  459.  
  460. sub Initialize{
  461. format Test_8_Header =
  462.        @<<<<<<<<<<<<<<<<<<<<<<<<<<< @|||||||||||| @|||||||||||| @|||||||||||
  463.        $FieldNames[0],     $FieldNames[1], $FieldNames[2], $FieldNames[3]
  464.        ---------------------------- ------------- ------------- ------------
  465. .
  466. format Test_8_Body =
  467.    @>. @<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<<<<<<
  468.  ++$Num, $Data{$FieldNames[0]},  $Data{$FieldNames[1]},   $Data{$FieldNames[2]}, $Data{$FieldNames[3]}
  469. .
  470. format Test_9_Header =
  471.           @<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<<
  472.            $FieldNames[0],  $FieldNames[1],   $FieldNames[2], $FieldNames[3]
  473. .
  474. format Test_9_Body =
  475.           @<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<<
  476.            $Data{$FieldNames[0]},  $Data{$FieldNames[1]},   $Data{$FieldNames[2]}, $Data{$FieldNames[3]}
  477. .
  478. }
  479.