p5-DBIWrapper/libdbiwrapper-perl-0.30/test.pl

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..30\n"; }
END {print "not ok 1\n" unless $loaded;}
use DBIWrapper;
use DBIWrapper::XMLParser;
$loaded = 1;
print "ok 1\n";

print "Comment out the following line to actually run these tests, after you setup your test database.\n";
exit 0;

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

my $dbHost = "localhost";
my $dbName = "testing_db";
my $dbUser = "ss";
my $dbPasswd = "foo";  # make sure a password is specified, even if it isn't needed.
my $dbType = "Pg";  # mysql for MySQL
my $dbPort = "5432"; # 3306 for MySQL
my $longRunningLog = "/tmp/dbiwrapper-long-running-sql.log";
my $sqlStatementLog = "/tmp/dbiwrapper-sql-statements.log";
my $logSQLStatements = 1;

my $verbose = 0;

if (-e $sqlStatementLog)
{
  print "Deleting $sqlStatementLog...\n";
  unlink $sqlStatementLog;
}

print "Instantiating an instance...\n";
my $db = DBIWrapper->new(dbType => $dbType, dbHost => $dbHost, dbName => $dbName, dbUser => $dbUser, dbPasswd => $dbPasswd, dbPort => $dbPort, printError => 0, longRunningLog => $longRunningLog, longRunningRead => 1, longRunningWrite => 1, sqlStatementLog => $sqlStatementLog, logSQLStatements => $logSQLStatements);
if ($db->error())
{
  die $db->errorMessage();
}
print "ok 2\n";

print "Checking current date...\n";
my $sth = $db->read("SELECT now()");
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
my @row = $sth->fetchrow_array;
$sth->finish;
print "Current Database time is '$row[0]'.\n" if ($verbose);
print "ok 3\n";

print "Getting all rows...\n";
$sth = $db->read(sql => "SELECT * FROM test_tb ORDER BY name, value");
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
while (@row = $sth->fetchrow_array)
{
  print "\tname='" . $row[0] . "', value='" . $row[1] . "'\n" if ($verbose);
}
$sth->finish;
print "ok 4\n";

print "Inserting dummy data and getting the ID value via getID()...\n";
$db->write(sql => "INSERT INTO test_tb (name, value) VALUES (?, ?)", plug => [ "dummy", "entry2" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
my $id = $db->getID("test_tb.ID");
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ID = '$id'\n";
print "ok 5\n";

print "Looking for new row (plug and substitute)...\n";
$sth = $db->read(sql => "SELECT * FROM test_tb WHERE name = ? ORDER BY name, ##?1##", plug => [ "dummy" ], substitute => [ "value" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
while (@row = $sth->fetchrow_array)
{
  print "\tname='" . $row[0] . "', value='" . $row[1] . "'\n" if ($verbose);
}
$sth->finish;  # necessary as DBI doesn't appear to properly cleanup when the
# end of data is reached.
print "ok 6\n";

print "Getting all rows (again - using substitution)...\n";
$sth = $db->read(sql => "SELECT * FROM test_tb ORDER BY ##?1##, ##?2##", substitute => [ "name", "value" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
while (@row = $sth->fetchrow_array)
{
  print "\tname='" . $row[0] . "', value='" . $row[1] . "'\n" if ($verbose);
}
$sth->finish;
print "ok 7\n";

print "Committing transaction...\n";
$db->commit;
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ok 8\n";

print "Deleting new row (testing substitution code)...\n";
my $rv = $db->write(sql => "DELETE FROM test_tb WHERE ##?1##", substitute => [ "name = 'dummy'" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "'$rv' rows deleted.\n" if ($verbose);
print "ok 9\n";

print "Committing transaction...\n";
$db->commit;
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ok 10\n";

print "Re-Inserting dummy data...\n";
$db->write(sql => "INSERT INTO test_tb (name, value) VALUES (?, ?)", plug => [ "dummy", "entry2" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ok 11\n";

print "Rolling back the transaction...\n";
$db->rollback;
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ok 12\n";

print "Getting all rows (again - using substitution)...\n";
$sth = $db->read(sql => "SELECT * FROM test_tb ORDER BY ##?1##, ##?2##", substitute => [ "name", "value" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
while (@row = $sth->fetchrow_array)
{
  print "\tname='" . $row[0] . "', value='" . $row[1] . "'\n" if ($verbose);
}
$sth->finish;
print "ok 13\n";

print "Re-Inserting dummy data...\n";
$db->write(sql => "INSERT INTO test_tb (name, value) VALUES (?, ?)", plug => [ "dummy", "entry2" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ok 14\n";

print "Committing transaction...\n";
$db->commit;
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ok 15\n";

print "Getting all rows (again - using substitution)...\n";
$sth = $db->read(sql => "SELECT * FROM test_tb ORDER BY ##?1##, ##?2##", substitute => [ "name", "value" ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
while (@row = $sth->fetchrow_array)
{
  print "\tname='" . $row[0] . "', value='" . $row[1] . "'\n" if ($verbose);
}
$sth->finish;
print "ok 16\n";

print "Testing the readXML method...\n";
my $resultDoc = <<"END_OF_CODE";
<?xml version="1.0" encoding="ISO-8859-1"?>
<resultset version="1.2">
  <select sql="SELECT name, value FROM test_tb ORDER BY name, value" plug="''"/>
  <status result="Ok" error=""/>
  <rows numRows="2" columns="1">
    <row>
      <column name="name" value="dummy"/>
      <column name="value" value="entry2"/>
    </row>
    <row>
      <column name="name" value="test"/>
      <column name="value" value="entry"/>
    </row>
  </rows>
</resultset>
END_OF_CODE

my $xmlDoc = $db->readXML(sql => "SELECT name, value FROM test_tb ORDER BY name, value", columns => 1);
if ($db->error())
{
  $db->close();
  die $xmlDoc;
}
print $xmlDoc if ($verbose);
if ($xmlDoc eq $resultDoc)
{
  print "ok 17\n";
}
else
{
  print "failed 17\n";
}

print "Running through XMLParser...\n";
my $xmlParserObj = DBIWrapper::XMLParser->new(string => $xmlDoc);
my $resultSetObj = $xmlParserObj->parse();
my $xmlDoc2 = $resultSetObj->generateXML();

if ($xmlDoc2 eq $xmlDoc)
{
  print "ok 18\n";
}
else
{
  print "failed 18\n";
}

print "Inserting complex data and retrieving via XML...\n";
my $complexData = <<"END_OF_DATA";
This is a "test"!
I 'wonder' what DBI will do with
this &embeded <stuff>!?
END_OF_DATA

$db->write(sql => "INSERT INTO test_tb (name, value) VALUES (?, ?)", plug => [ "complex", $complexData ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}

$resultDoc = <<"END_OF_CODE";
<?xml version="1.0" encoding="ISO-8859-1"?>
<resultset version="1.2">
  <select sql="SELECT name, value FROM test_tb WHERE name = 'complex' ORDER BY name, value" plug="''"/>
  <status result="Ok" error=""/>
  <rows numRows="1" columns="1">
    <row>
      <column name="name" value="complex"/>
      <column name="value" value="This is a &quot;test&quot;!\\nI 'wonder' what DBI will do with\\nthis &amp;embeded &lt;stuff&gt;!?\\n"/>
    </row>
  </rows>
</resultset>
END_OF_CODE

$xmlDoc = $db->readXML(sql => "SELECT name, value FROM test_tb WHERE name = 'complex' ORDER BY name, value", columns => 1);
if ($db->error())
{
  $db->close();
  die $xmlDoc;
}
print $xmlDoc if ($verbose);
if ($xmlDoc eq $resultDoc)
{
  print "ok 19\n";
}
else
{
  print "failed 19\n";
}

$db->rollback;

print "Testing the readXML method (noncolumnar)...\n";
my $resultDoc = <<"END_OF_CODE";
<?xml version="1.0" encoding="ISO-8859-1"?>
<resultset version="1.2">
  <select sql="SELECT name, value FROM test_tb ORDER BY name, value" plug="''"/>
  <status result="Ok" error=""/>
  <rows numRows="2" columns="0">
    <row name="dummy" value="entry2"/>
    <row name="test" value="entry"/>
  </rows>
</resultset>
END_OF_CODE

my $xmlDoc = $db->readXML(sql => "SELECT name, value FROM test_tb ORDER BY name, value");
if ($db->error())
{
  $db->close();
  die $xmlDoc;
}
print $xmlDoc if ($verbose);
if ($xmlDoc eq $resultDoc)
{
  print "ok 20\n";
}
else
{
  print "failed 20\n";
}

print "Inserting complex data and retrieving via XML (noncolumnar)...\n";
my $complexData = <<"END_OF_DATA";
This is a "test"!
I 'wonder' what DBI will do with
this &embeded <stuff>!?
END_OF_DATA

$db->write(sql => "INSERT INTO test_tb (name, value) VALUES (?, ?)", plug => [ "complex", $complexData ]);
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}

$resultDoc = <<"END_OF_CODE";
<?xml version="1.0" encoding="ISO-8859-1"?>
<resultset version="1.2">
  <select sql="SELECT name, value FROM test_tb WHERE value LIKE '%&quot;test&quot;%' ORDER BY name, value" plug="''"/>
  <status result="Ok" error=""/>
  <rows numRows="1" columns="0">
    <row name="complex" value="This is a &quot;test&quot;!\\nI 'wonder' what DBI will do with\\nthis &amp;embeded &lt;stuff&gt;!?\\n"/>
  </rows>
</resultset>
END_OF_CODE

$xmlDoc = $db->readXML(sql => "SELECT name, value FROM test_tb WHERE value LIKE '%\"test\"%' ORDER BY name, value");
if ($db->error())
{
  $db->close();
  die $xmlDoc;
}
print $xmlDoc if ($verbose);
if ($xmlDoc eq $resultDoc)
{
  print "ok 21\n";
}
else
{
  print "failed 21\n";
}

print "Testing error returned by readXML()...\n";
$resultDoc = <<"END_OF_DATA";
<?xml version="1.0" encoding="ISO-8859-1"?>
<resultset version="1.2">
  <select sql="SELECT invalid FROM test_tb" plug="''"/>
  <status result="Error" error="DBIWrapper-&gt;readXML() - Error!&lt;br /&gt;\\n\\nDBIWrapper-&gt;getDataHashHeader() - Error!&lt;br /&gt;\\n\\nDBIWrapper-&gt;read() - Error!&lt;br /&gt;\\nEval of execute failed!&lt;br /&gt;\\nError = 'DBD::Pg::st execute failed: ERROR:  column &quot;invalid&quot; does not exist at character 8\\n'.&lt;br /&gt;\\nsql='SELECT invalid FROM test_tb'.&lt;br /&gt;\\nplug=''.&lt;br /&gt;\\n\\n"/>
  <rows numRows="0" columns="0"/>
</resultset>
END_OF_DATA

$xmlDoc = $db->readXML(sql => "SELECT invalid FROM test_tb");
if ($db->error())
{
  $db->close();
  die $xmlDoc;
}
$xmlDoc =~ s/(\/usr\/lib\/perl5\/site_perl\/5\.[68]\.[01234]\/DBIWrapper.pm)/DBIWrapper.pm/;
$xmlDoc =~ s/(blib\/lib\/DBIWrapper.pm)/DBIWrapper.pm/;
print $xmlDoc if ($verbose);
if ($xmlDoc eq $resultDoc)
{
  print "ok 22\n";
}
else
{
  print "failed 22\n";
  print "resultDoc:\n$resultDoc\n\nxmlDoc:\n$xmlDoc\n\n";
}
$db->resetError();  # make sure we cleanup for future error tests.

print "Testing boolToDBI()...\n";
my $result = $db->boolToDBI("false");
if ($result == 0)
{
  $result = $db->boolToDBI(string => "true");
  if ($result == 1)
  {
    $result = $db->boolToDBI(string => 0);
    if ($result == 0)
    {
      $result = $db->boolToDBI("t");
      if ($result == 1)
      {
        $result = $db->boolToDBI(string => "fa");
        if ($result == 0)
        {
          $result = $db->boolToDBI("1");
          if ($result == 1)
          {
            print "ok 23\n";
          }
          else
          {
            print "failed 23 - string = '1'\n";
          }
        }
        else
        {
          print "failed 23 - string = 'fa'\n";
        }
      }
      else
      {
        print "failed 23 - string = 't'\n";
      }
    }
    else
    {
      print "failed 23 - string = '0'\n";
    }
  }
  else
  {
    print "failed 23 - string = 'true'\n";
  }
}
else
{
  print "failed 23 - string = 'false'\n";
}

print "Testing dbiToBool()...\n";
my $result = $db->dbiToBool("0");
if ($result eq "false")
{
  $result = $db->dbiToBool(string => "1");
  if ($result eq "true")
  {
    $result = $db->dbiToBool(string => 0);
    if ($result eq "false")
    {
      $result = $db->dbiToBool("1");
      if ($result eq "true")
      {
        $result = $db->dbiToBool(string => "fa");
        if ($result eq "false")
        {
          print "ok 24\n";
        }
        else
        {
          print "failed 24 - string = 'fa'\n";
        }
      }
      else
      {
        print "failed 24 - string = '1'\n";
      }
    }
    else
    {
      print "failed 24 - string = '0'\n";
    }
  }
  else
  {
    print "failed 24 - string = '1'\n";
  }
}
else
{
  print "failed 24 - string = '0'\n";
}

print "Committing transaction (to clear error condition)...\n";
$db->commit;
if ($db->error())
{
  $db->close();
  die $db->errorMessage();
}
print "ok 25\n";

print "Testing the readHTML method...\n";
my $resultDoc = <<"END_OF_CODE";
<div class="sqlNumRows"><span class="sqlNumRows"><b>2</b> rows returned.</span></div>
<table class="">
  <thead>
    <tr class="sqlHeader">
    <th class="name">name</th>
    <th class="value">value</th>
    </tr>
  </thead>
  <tbody>
  <tr class="sqlRow sqlEven">
    <td class="name"><span class="name">dummy</span></td>
    <td class="value"><span class="value">entry2</span></td>
  </tr>
  <tr class="sqlRow sqlOdd">
    <td class="name"><span class="name">test</span></td>
    <td class="value"><span class="value">entry</span></td>
  </tr>
  </tbody>
</table>
END_OF_CODE

my $htmlDoc = $db->readHTML(sql => "SELECT name, value FROM test_tb ORDER BY name, value");
if ($db->error())
{
  $db->close();
  die $htmlDoc;
}
print $htmlDoc if ($verbose);
if ($htmlDoc eq $resultDoc)
{
  print "ok 26\n";
}
else
{
  print "failed 26\n";
  print "resultDoc:\n$resultDoc\n\nhtmlDoc:\n$htmlDoc\n\n";
}

print "Testing error returned by readHTML()...\n";
$resultDoc = <<"END_OF_DATA";
<div class="sqlNumRows"><span class="sqlNumRows"><b>0</b> rows returned.</span></div>
<table class="">
  <tr class="sqlError">
    <td class="sqlError"><span class="sqlError">DBIWrapper->readHTML() - Error!<br />\n\nDBIWrapper->getDataHashHeader() - Error!<br />\n\nDBIWrapper->read() - Error!<br />\nEval of execute failed!<br />\nError = 'DBD::Pg::st execute failed: ERROR:  column "invalid" does not exist at character 8\n'.<br />\nsql='SELECT invalid FROM test_tb'.<br />\nplug=''.<br />\n\n</span></td>
  </tr>
</table>
END_OF_DATA

$htmlDoc = $db->readHTML(sql => "SELECT invalid FROM test_tb");
if ($db->error())
{
  $db->close();
  die $htmlDoc;
}
$htmlDoc =~ s/(\/usr\/lib\/perl5\/site_perl\/5\.[68]\.[01234]\/DBIWrapper.pm)/DBIWrapper.pm/;
$htmlDoc =~ s/(blib\/lib\/DBIWrapper.pm)/DBIWrapper.pm/;
print $htmlDoc if ($verbose);
if ($htmlDoc eq $resultDoc)
{
  print "ok 27\n";
}
else
{
  print "failed 27\n";
  print "resultDoc:\n$resultDoc\n\nhtmlDoc:\n$htmlDoc\n\n";
}
$db->resetError();  # make sure we cleanup for future error tests.
$db->commit();

# now test longRunning sql handling.
print "Testing longRunningRead sql handling...\n";
if ( -e $longRunningLog )
{
  print "Removing previous log file '$longRunningLog'...\n";
  print "-" x 30 . "\n";
  open F, "<$longRunningLog";
  my @lines = <F>;
  close F;
  print join("", @lines);
  print "-" x 30 . "\n";
  unlink $longRunningLog;
}
my @result = $db->getDataHash(sql => "SELECT pg_sleep(2),\nnow() AS current_time, ? || ' Test' AS name", plug => [ 0 ]);
print "RESULT: " . join(", ", map {"$_='$result[0]->{$_}'"} sort keys %{$result[0]}) . "\n";
if (-e $longRunningLog)
{
  open F, "<$longRunningLog";
  my @lines = <F>;
  close F;
  print "After:\n";
  print "-" x 30 . "\n";
  print join("", @lines);
  print "-" x 30 . "\n";
  print "ok 28\n";
}
else
{
  print "failed 28\n";
}

print "Verifying $sqlStatementLog was populated...\n";
if (-e $sqlStatementLog)
{
  print "ok 29\n";
}
else
{
  print "failed 29\n";
}

print "Closing connection...\n";
$db->close();
if ($db->error())
{
  die $db->errorMessage();
}
print "ok 30\n";