Initial creation code and tests.

Supporters/lib/Supporters.pm

@@ -27,8 +27,23 @@ our @EXPORT = qw(
 
 our $VERSION = '0.02';
 
+######################################################################
+sub new ($$) {
+  my $package = shift;
+  my($dbh, $ledgerCmd) = @_;
+
+  return bless({ dbh => $dbh, ledgerCmd => $ledgerCmd },
+                 $package);
+}
+######################################################################
+sub dbh ($) {
+  return $_[0]->{dbh};
+}
+######################################################################
+sub ledgerCmd ($) {
+  return $_[0]->{ledgerCmd};
+}
 
-# Preloaded methods go here.
 
 1;
 __END__

Supporters/t/CreateTestDB.pl

@@ -0,0 +1,41 @@
+=pod
+
+This little file creates a test database for use by the tests.
+
+=cut
+
+use DBI;
+use File::Spec;
+use autodie;
+use File::Slurp;
+sub get_test_dbh {
+  eval {
+    unlink('test-supporters.db');
+  };
+  die $@ if ($@ and $@->isa('autodie::exception') and (not $@->matches('unlink')));
+
+
+  my $dbh = DBI->connect("dbi:SQLite:dbname=test-supporters.db", "", "",
+                                     { RaiseError => 1, sqlite_unicode => 1})
+    or die $DBI::errstr;
+
+  open (SQL, '<', File::Spec->catdir(File::Spec->updir(), 'sql', 'supporters-schema.sql'));
+  while (my $line = <SQL>) {
+    chomp $line;
+    $line = join(' ',split(' ',$line));
+    if ((substr($line,0,2) ne '--') and (substr($line,0,3) ne 'REM')) {
+      if (substr($line,- 1,1) eq ';') {
+        $query .= ' ' . substr($line,0,length($line) -1);
+        $dbh->do($query) or warn "Can't execute statement in file, line $.: " . $dbh->errstr;
+        $query = ' ';
+      } else {
+        $query .= ' ' . $line;
+      }
+    }
+  }
+  close(SQL);
+  die $dbh->errstr if $dbh->errstr;
+  return $dbh;
+}
+
+1;

Supporters/t/Supporters.t

@@ -3,16 +3,26 @@
 
 #########################
 
-# change 'tests => 1' to 'tests => last_test_to_print';
-
 use strict;
 use warnings;
 
-use Test::More tests => 1;
+use Test::More tests => 3;
 BEGIN { use_ok('Supporters') };
 
-#########################
+=pod
 
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
+Initial tests to verify creation of objects
+
+=cut
+
+require 't/CreateTestDB.pl';
+
+my $dbh = get_test_dbh();
+
+my $supporters = new Supporters($dbh, "testcmd");
+
+is($dbh, $supporters->dbh());
+is("testcmd", $supporters->ledgerCmd());
+
+$dbh->disconnect();