[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[2403] trunk
- Subject: SF.net SVN: ledger-smb:[2403] trunk
- From: ..hidden..
- Date: Mon, 17 Nov 2008 17:30:44 +0000
Revision: 2403
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=2403&view=rev
Author: einhverfr
Date: 2008-11-17 17:30:44 +0000 (Mon, 17 Nov 2008)
Log Message:
-----------
More test cases and framework stuff. t/62-api.t is currently not working.
Modified Paths:
--------------
trunk/README.tests
trunk/t/11-ledgersmb.t
trunk/t/43-dbtest.t
Added Paths:
-----------
trunk/LedgerSMB/DBTest.pm
trunk/t/62-api.t
trunk/t/63-lwp.t
trunk/t/data/62-request-data
trunk/t/data/62.d/
Added: trunk/LedgerSMB/DBTest.pm
===================================================================
--- trunk/LedgerSMB/DBTest.pm (rev 0)
+++ trunk/LedgerSMB/DBTest.pm 2008-11-17 17:30:44 UTC (rev 2403)
@@ -0,0 +1,126 @@
+
+=head1 NAME
+
+LedgerSMB::DBTest - LedgerSMB commit filter for test cases.
+
+=head1 SYOPSIS
+
+This module creates a DBI-like interface but ensures autocommit is off,
+and filters commit statements such that they don't do anything. This can be
+used for making API test cases which involve DB commits safe for production
+environments.
+
+=head1 USAGE
+
+Both LedgerSMB.pm and LedgerSMB/Form.pm assign a global database handler for all
+database access within a script in the dbh property (for example,
+$request->{dbh} or $form->{dbh}). By setting this early to a
+LedgerSMB::DBTest (instead of a DBI object), the tests can be made safe.
+
+However, there are a few limitations to be aware of. One cannot run tests
+through the standard request handler and use this module. Hence this is limited
+to unit tests of files in the LedgerSMB, scripts, and bin directories.
+
+Here is an example of how this could be done:
+
+ my $lsmb = LedgerSMB->new();
+ $lsmb->merge($testdata);
+ my $dbh = LedgerSMB::DBTest->connect("dbi:Pg:dbname=$company", "$username",
+ "$password",)
+ $lsmb->{dbh} = $dbh;
+
+
+=head1 METHODS
+
+=over
+
+=item connect($dsn, $user, $pass)
+
+Connects to the database and returns a LedgerSMB::DBTest object
+
+=item commit()
+
+Tests the current transaction (issues a 'SELECT 1;' to the database). If this
+is successful returns 1, if not, rolls back and returns false.
+
+Note that this means all past tests are rolled back and this is inconsistent
+with normal transactional behavior.
+
+=item prepare()
+
+Returns a statement handle, via the private DBI database handle.
+
+=item do()
+
+passes this statement on to the private database handle
+
+=item errstr()
+
+passes this call on to the private database handle
+
+=item err()
+
+passes this call on to the private database handle
+
+=item rollback()
+
+passes this call on to the private database handle. Note that this will roll
+back all statements issues through this object.
+
+=back
+
+=cut
+
+use DBI;
+package LedgerSMB::DBTest;
+
+sub DISTROY {
+ my ($self) = @_;
+ $self->disconnect;
+}
+
+sub connect{
+ my ($class, $dsn, $user, $pass) = @_;
+ my $self = {};
+ $self->{_dbh} = DBI->connect($dsn, $user, $pass, {AutoCommit => 0 });
+ bless $self, $class;
+ return $self;
+}
+
+sub disconnect {
+ my ($self) = @_;
+ $self->rollback;
+ $self->{_dbh}->disconnect;
+}
+
+sub do {
+ my ($self, $statement) = @_;
+ return $self->{_dbh}->do($statement);
+}
+
+sub err{
+ my ($self) = @_;
+ return $self->{_dbh}->err;
+}
+
+sub errstr{
+ my ($self) = @_;
+ return $self->{_dbh}->errstr;
+}
+
+sub prepare{
+ my ($self, $statement) = @_;
+ return $self->{_dbh}->prepare($statement);
+}
+
+sub rollback {
+ my ($self) = @_;
+ return $self->{_dbh}->rollback;
+}
+
+sub state{
+ my ($self) = @_;
+ return $self->{_dbh}->state;
+}
+
+1;
Modified: trunk/README.tests
===================================================================
--- trunk/README.tests 2008-11-15 23:59:05 UTC (rev 2402)
+++ trunk/README.tests 2008-11-17 17:30:44 UTC (rev 2403)
@@ -8,3 +8,27 @@
90 - 99: Packaging checks
Environment variables can be used as flags to disable/enable tests >= 40
+
+LSMB_TEST_DB must be set to a defined value if databases are going to be tested.
+
+if LSMB_NEW_DB is set, test 40 (when it is complete) will create a database with
+the name from this environment variable, and subsequent database tests will run
+against that database. If this is not set, and PGDATABASE is set, tests will
+run on that database. If neither are set, the tests will bail out.
+
+Special notes on specific test cases:
+
+42-dbobject.t: Some tests will run even if LSMB_TEST_DB is not enabled. These
+tests do not require a database connection.
+
+43-dbtest.t: This runs defined test cases from sql/modules/test/. If new
+scripts are added, they must be listed in this script as well.
+
+62-api.t uses request hashes defined in t/data/62-request-data. This
+script employs a database commit filter to prevent commits to the db. It is
+safe to run on existing databases.
+
+63-lwp.t will re-use the request hashes defined in test/data/62-request-data.
+It does NOT employ a commit filter, so is NOT safe to run against production
+data. It will only run if the environment variable LSMB_TEST_LWN is set to true.
+
Modified: trunk/t/11-ledgersmb.t
===================================================================
--- trunk/t/11-ledgersmb.t 2008-11-15 23:59:05 UTC (rev 2402)
+++ trunk/t/11-ledgersmb.t 2008-11-17 17:30:44 UTC (rev 2403)
@@ -12,7 +12,7 @@
use LedgerSMB::Sysconfig;
use LedgerSMB;
-
+my $lsmb;
sub redirect {
print "redirected\n";
}
@@ -34,7 +34,7 @@
##547 merge
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
my %myconfig;
my $utfstr;
my @r;
@@ -43,7 +43,7 @@
isa_ok($lsmb, 'LedgerSMB');
# $lsmb->escape checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
$utfstr = "\xd8\xad";
utf8::decode($utfstr);
ok(!$lsmb->escape, 'escape: (undef)');
@@ -61,7 +61,7 @@
}
# $lsmb->is_blank checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
$lsmb->{blank} = ' ';
$lsmb->{notblank} = ' d ';
TODO: {
@@ -74,7 +74,7 @@
is($lsmb->is_blank('name' => 'blank'), 1, 'is_blank: blank');
# $lsmb->is_run_mode checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
$ENV{GATEWAY_INTERFACE} = 'foo';
is($lsmb->is_run_mode('cgi'), 1, 'is_run_mode: CGI - CGI');
is($lsmb->is_run_mode('cli'), 0, 'is_run_mode: CGI - CLI');
@@ -101,7 +101,7 @@
is($lsmb->is_run_mode, 0, 'is_run_mode: CLI - (unknown mode)');
# $lsmb->num_text_rows checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10, 'max' => 5),
2, 'num_text_rows: 2 rows, no column breakage, max 5 rows');
is($lsmb->num_text_rows('string' => "apple\npear", 'cols' => 10, 'max' => 1),
@@ -124,7 +124,7 @@
3, 'num_text_rows: 3 rows, word and non column breakage, no max row count');
# $lsmb->debug checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
@r = trap{$lsmb->debug()};
#SKIP: {like($trap->stdout, qr|\n\$VAR1 = bless\( {[\n\s]+'action' => '',[\n\s]+'dbversion' => '\d+\.\d+\.\d+',[\n\s]+'path' => 'bin/mozilla',[\n\s]+'version' => '$lsmb->{version}'[\n\s]+}, 'LedgerSMB' \);|,
# 'debug: $lsmb->debug');
@@ -138,9 +138,18 @@
my @str = <$FH>;
close($FH);
chomp(@str);
- #FIXME test broken below:
- #like(join("\n", @str), qr|\$VAR1 = 'file';\n\$VAR2 = 't/var/lsmb-11.$$';\n\$VAR3 = bless\( {[\n\s]+'action' => '',[\n\s]+'dbversion' => '\d+\.\d+\.\d+',[\n\s]+'file' => 't/var/lsmb-11.$$',[\n\s]+'path' => 'bin/mozilla',[\n\s]+'version' => '$lsmb->{version}'[\n\s]+}, 'LedgerSMB' \);|,
- # 'debug: $lsmb with file, contents');
+ cmp_ok(grep (/\s?\$VAR1\s=\sbless/, @str), '>', 0,
+ 'Debug Contents, var1 type');
+ cmp_ok(grep (/'action' => ''/, @str), '>', 0,
+ 'Debug contents, blank action');
+ cmp_ok(grep (/'dbversion' => '\d+\.\d+\.\d+'/, @str), '>', 0,
+ 'Debug contents, dbversion format');
+ cmp_ok(grep (/'path' => 'bin\/mozilla'/, @str), '>', 0,
+ 'Debug contents, path');
+ cmp_ok(grep (/'version' => '$lsmb->{version}'/, @str), '>', 0,
+ 'Debug contents, version match');
+ cmp_ok(grep (/'file' => 't\/var\/lsmb-11.$$'/, @str), '>', 0,
+ 'Debug contents file attribute match');
is(unlink("t/var/lsmb-11.$$"), 1, "debug: removing t/var/lsmb-11.$$");
ok(!-e "t/var/lsmb-11.$$", "debug: t/var/lsmb-11.$$ removed");
};
@@ -152,7 +161,7 @@
ok(!-e $lsmb->{file}, "debug: file creation failed");
# $lsmb->new checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
ok(defined $lsmb, 'new: blank, defined');
isa_ok($lsmb, 'LedgerSMB', 'new: blank, correct type');
ok(defined $lsmb->{action}, 'new: blank, action defined');
@@ -160,41 +169,21 @@
ok(defined $lsmb->{path}, 'new: blank, path defined');
ok(defined $lsmb->{version}, 'new: blank, version defined');
-#my $lsmb = LedgerSMB->new();
-#ok(defined $lsmb, 'new: action set, defined');
-#isa_ok($lsmb, 'LedgerSMB', 'new: action set, correct type');
-#ok(defined $lsmb->{action}, 'new: action set, action defined');
-#is($lsmb->{action}, 'apple_sauce', 'new: action set, action processed');
-#ok(defined $lsmb->{dbversion}, 'new: action set, dbversion defined');
-#ok(defined $lsmb->{path}, 'new: action set, path defined');
-#ok(defined $lsmb->{version}, 'new: action set, version defined');
+$lsmb = LedgerSMB->new('path=bin/lynx');
+ok(defined $lsmb, 'new: lynx, defined');
+isa_ok($lsmb, 'LedgerSMB', 'new: lynx, correct type');
+ok(defined $lsmb->{action}, 'new: lynx, action defined');
+ok(defined $lsmb->{dbversion}, 'new: lynx, dbversion defined');
+ok(defined $lsmb->{path}, 'new: lynx, path defined');
+is($lsmb->{path}, 'bin/lynx', 'new: lynx, path carried through');
+ok(defined $lsmb->{lynx}, 'new: lynx, lynx defined');
+is($lsmb->{lynx}, 1, 'new: lynx, lynx enabled');
+ok(defined $lsmb->{menubar}, 'new: lynx, menubar defined (deprecated)');
+is($lsmb->{menubar}, 1, 'new: lynx, menubar enabled (deprecated)');
+ok(defined $lsmb->{version}, 'new: lynx, version defined');
-#my $lsmb = LedgerSMB->new();
-#ok(defined $lsmb, 'new: lynx, defined');
-#isa_ok($lsmb, 'LedgerSMB', 'new: lynx, correct type');
-#ok(defined $lsmb->{action}, 'new: lynx, action defined');
-#ok(defined $lsmb->{dbversion}, 'new: lynx, dbversion defined');
-#ok(defined $lsmb->{path}, 'new: lynx, path defined');
-#is($lsmb->{path}, 'bin/lynx', 'new: lynx, path carried through');
-#ok(defined $lsmb->{lynx}, 'new: lynx, lynx defined');
-#is($lsmb->{lynx}, 1, 'new: lynx, lynx enabled');
-#ok(defined $lsmb->{menubar}, 'new: lynx, menubar defined (deprecated)');
-#is($lsmb->{menubar}, 1, 'new: lynx, menubar enabled (deprecated)');
-#ok(defined $lsmb->{version}, 'new: lynx, version defined');
-
-# THe test cases below are incomplete and need to be finished
..hidden.. = trap {$lsmb = LedgerSMB->new()};
-#is($trap->die, "Error: Access Denied\n",
-# 'new: directory traversal 1 caught');
..hidden.. = trap {$lsmb = LedgerSMB->new()};
-#is($trap->die, "Error: Access Denied\n",
-# 'new: directory traversal 2 caught');
..hidden.. = trap {$lsmb = LedgerSMB->new()};
-#is($trap->die, "Error: Access Denied\n",
-# 'new: directory traversal 3 caught');
-
# $lsmb->redirect checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
ok(!defined $lsmb->{callback}, 'redirect: No callback set');
@r = trap{$lsmb->redirect};
is($trap->stdout, "redirected\n", 'redirect: No message or callback redirect');
@@ -210,49 +199,47 @@
@r = trap{$lsmb->redirect('msg' => "hello world\n")};
is($trap->stdout, "redirected\n", 'redirect: callback and message redirect');
-# Commenting out tests that have to hit db, since this doesn't work so well with
-# 1.3
# $lsmb->call_procedure checks
-#my $lsmb = LedgerSMB->new();
-#$lsmb->{dbh} = ${LedgerSMB::Sysconfig::GLOBALDBH};
..hidden.. = $lsmb->call_procedure('procname' => 'character_length',
-# 'args' => ['month']);
-#is($#r, 0, 'call_procedure: correct return length (one row)');
-#is($r[0]->{'character_length'}, 5,
-# 'call_procedure: single arg, non-numeric return');
-#
..hidden.. = $lsmb->call_procedure('procname' => 'trunc', 'args' => [57.1, 0]);
-#is($r[0]->{'trunc'}, Math::BigFloat->new('57'),
-# 'call_procedure: two args, numeric return');
-#
..hidden.. = $lsmb->call_procedure('procname' => 'pi', 'args' => []);
-#like($r[0]->{'pi'}, qr/^3.14/,
-# 'call_procedure: empty arg list, non-numeric return');
+SKIP: {
+ skip 'Skipping call_procedure tests, no db specified'
+ if !defined $ENV{PGDATABASE};
+ $lsmb = LedgerSMB->new();
+ $lsmb->{dbh} = DBI->connect("dbi:Pg:dbname=$ENV{PGDATABASE}",
+ undef, undef, {AutoCommit => 0 });
+ @r = $lsmb->call_procedure('procname' => 'character_length',
+ 'args' => ['month']);
+ is($#r, 0, 'call_procedure: correct return length (one row)');
+ is($r[0]->{'character_length'}, 5,
+ 'call_procedure: single arg, non-numeric return');
-##
-##TODO: {
-## local $TODO = 'Breaks when no arglist given';
-## @r = $lsmb->call_procedure('procname' => 'pi');
-## like($r[0]->{'pi'}, qr/^3.14/,
-## 'call_procedure: no args, non-numeric return');
-##}
+ @r = $lsmb->call_procedure('procname' => 'trunc', 'args' => [57.1, 0]);
+ is($r[0]->{'trunc'}, Math::BigFloat->new('57'),
+ 'call_procedure: two args, numeric return');
+ @r = $lsmb->call_procedure('procname' => 'pi', 'args' => []);
+ like($r[0]->{'pi'}, qr/^3.14/,
+ 'call_procedure: empty arg list, non-numeric return');
+ @r = $lsmb->call_procedure('procname' => 'pi');
+ like($r[0]->{'pi'}, qr/^3.14/,
+ 'call_procedure: no args, non-numeric return');
+}
+
# $lsmb->merge checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
$lsmb->merge({'apple' => 1, 'pear' => 2, 'peach' => 3}, 'keys' => ['apple', 'pear']);
ok(!defined $lsmb->{peach}, 'merge: Did not add unselected key');
is($lsmb->{apple}, 1, 'merge: Added unselected key apple');
is($lsmb->{pear}, 2, 'merge: Added unselected key pear');
like($lsmb->{path}, qr#bin/(lynx|mozilla)#, 'merge: left existing key');
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
$lsmb->merge({'apple' => 1, 'pear' => 2, 'peach' => 3});
is($lsmb->{apple}, 1, 'merge: No key, added apple');
is($lsmb->{pear}, 2, 'merge: No key, added pear');
is($lsmb->{peach}, 3, 'merge: No key, added peach');
like($lsmb->{path}, qr#bin/(lynx|mozilla)#, 'merge: No key, left existing key');
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
$lsmb->merge({'apple' => 1, 'pear' => 2, 'peach' => 3}, 'index' => 1);
is($lsmb->{apple_1}, 1, 'merge: Index 1, added apple as apple_1');
is($lsmb->{pear_1}, 2, 'merge: Index 1, added pear as pear_1');
@@ -260,7 +247,7 @@
like($lsmb->{path}, qr#bin/(lynx|mozilla)#, 'merge: Index 1, left existing key');
# $lsmb->is_allowed_role checks
-my $lsmb = LedgerSMB->new();
+$lsmb = LedgerSMB->new();
$lsmb->{_roles} = ['apple', 'pear'];
is($lsmb->is_allowed_role({allowed_roles => ['pear']}), 1,
'is_allowed_role: allowed role');
Modified: trunk/t/43-dbtest.t
===================================================================
--- trunk/t/43-dbtest.t 2008-11-15 23:59:05 UTC (rev 2402)
+++ trunk/t/43-dbtest.t 2008-11-17 17:30:44 UTC (rev 2403)
@@ -1,11 +1,17 @@
use Test::More;
use strict;
-if (!defined $ENV{PGDATABASE}){
- plan skip_all => 'PGDATABASE Environment Variable not set up';
+if (!defined $ENV{LSMB_TEST_DB}){
+ plan skip_all => 'Skipping all. Told not to test db.';
}
else {
plan tests => 50;
+ if (defined $ENV{LSMB_NEW_DB}){
+ $ENV{PGDATABASE} = $ENV{LSMB_NEW_DB};
+ }
+ if (!defined $ENV{PGDATABASE}){
+ die "We were told to run tests, but no database specified!";
+ }
}
my @testscripts = qw(Account Business_type Company Draft Payment
Added: trunk/t/62-api.t
===================================================================
--- trunk/t/62-api.t (rev 0)
+++ trunk/t/62-api.t 2008-11-17 17:30:44 UTC (rev 2403)
@@ -0,0 +1,76 @@
+BEGIN {
+ use LedgerSMB;
+ use Test::More;
+ use LedgerSMB::Template;
+ use LedgerSMB::DBTest;
+}
+
+our $test_case_defs = {
+};
+
+if (defined $ENV{LSMB_TEST_DB}){
+ if (defined $ENV{LSMB_NEW_DB}){
+ $ENV{PGDATABASE} = $ENV{LSMB_NEW_DB};
+ }
+ if (!defined $ENV{PGDATABASE}){
+ die "Oops... LSMB_TEST_DB set but no db selected!";
+ }
+ plan 'no_plan';
+} else {
+ plan skip_all => 'Skipping, LSMB_TEST_DB environment variable not set.';
+}
+
+do 't/data/62-request-data'; # Import test case hashes
+
+for (qw( admin.pl drafts.pl login.pl payment.pl
+ report.pl employee.pl menu.pl vendor.pl
+ customer.pl inventory.pl migration.pl recon.pl
+ vouchers.pl)){
+
+ do "$_";
+} # Import new code namespaces
+
+my $dbh = LedgerSMB::DBTest->connect("dbi:Pg:dbname=$ENV{PGDATABASE}", undef, undef);
+
+print scalar @$test_request_data ." test case scenarios defined";
+
+for my $test (@$test_request_data){
+ if (lc $test->{_codebase} eq 'old'){
+ old_code_test::_load_script($test->{module});
+ $old_code_test::form = new Form();
+ for (keys (%$test)){
+ $form->{$_} = $test->{$_};
+ }
+ ok(eval ("old_code_test::$test->{action}()"),
+ "$test->{_test_id}: Action Successful");
+ } else {
+ my $request = LedgerSMB->new();
+ $request->merge($test);
+ my $script = $test->{module};
+ $script =~ s/\.pl$//;
+ ok(eval "LedgerSMB::Scripts::$script::$request->{action}(\$request)");
+ }
+ for (@{$test_case_defs->{"$test->{_test_id}"}}){
+ &$_;
+ }
+ ok($dbh->rollback, "$test->{_test_id}: rollback");
+}
+
+package LedgerSMB::Template;
+
+# Don't render templates. Just return so we can run tests on data structures.
+sub render {
+ return 1;
+}
+
+package old_code_test;
+# Keeps old code isolated in a different namespace, and provides for reasonable
+# reload facilities.
+our $form;
+
+sub _load_script {
+ do "bin/arapprn.pl";
+ do "bin/arap.pl";
+ do "bin/io.pl";
+ do "bin/$1[0]";
+}
Added: trunk/t/data/62-request-data
===================================================================
--- trunk/t/data/62-request-data (rev 0)
+++ trunk/t/data/62-request-data 2008-11-17 17:30:44 UTC (rev 2403)
@@ -0,0 +1,58 @@
+
+our $test_request_data = [
+ # AR/AP Transaction Screen Tests
+ {
+ '_test_id' => 'AR Transaction Screen',
+ '_codebase' => 'old',
+ 'module' => 'ar.pl',
+ 'action' => 'add'
+ },
+ {
+ '_test_id' => 'AP Transaction Screen',
+ '_codebase' => 'old',
+ 'module' => 'ap.pl',
+ 'action' => 'add'
+ },
+ # Create Batch Screens
+ {
+ '_test_id' => 'AR Transaction Voucher Screen',
+ '_codebase' => 'new',
+ 'action' => 'create_batch',
+ 'batch_type' => 'recievable',
+ 'module' => 'vouchers.pl',
+ },
+ {
+ '_test_id' => 'AP Transaction Voucher Screen',
+ '_codebase' => 'new',
+ 'action' => 'create_batch',
+ 'batch_type' => 'payable',
+ 'module' => 'vouchers.pl',
+ },
+ {
+ '_test_id' => 'Payment Transaction Voucher Screen',
+ '_codebase' => 'new',
+ 'action' => 'create_batch',
+ 'batch_type' => 'payment',
+ 'module' => 'vouchers.pl',
+ },
+ {
+ '_test_id' => 'Payment Reversal Transaction Voucher Screen',
+ '_codebase' => 'new',
+ 'action' => 'create_batch',
+ 'batch_type' => 'payment_reversal',
+ 'module' => 'vouchers.pl',
+ },
+ {
+ '_test_id' => 'GL Transaction Voucher Screen',
+ '_codebase' => 'new',
+ 'action' => 'create_batch',
+ 'batch_type' => 'gl',
+ 'module' => 'vouchers.pl',
+ },
+];
+
+
+opendir (D62, 't/data/62.d');
+for my $testfile (readdir(D62)){
+ do "t/data/62.d/$testfile";
+};
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.