Tests for dbicadmin.
Aran Deltac [Sun, 30 Apr 2006 15:37:09 +0000 (15:37 +0000)]
scripts/dbicadmin [moved from maint/dbicadmin with 91% similarity]
t/helperrels/29dbicadmin.t [new file with mode: 0644]
t/run/29dbicadmin.tl [new file with mode: 0644]

similarity index 91%
rename from maint/dbicadmin
rename to scripts/dbicadmin
index 0f49332..e873745 100755 (executable)
@@ -12,6 +12,7 @@ $JSON::QuotApos = 1;
 GetOptions(
     'schema=s'  => \my $schema_class,
     'class=s'   => \my $resultset_class,
+    'connect=s' => \my $connect,
     'op=s'      => \my $op,
     'set=s'     => \my $set,
     'where=s'   => \my $where,
@@ -21,8 +22,13 @@ GetOptions(
     'trace'     => \my $trace,
     'quiet'     => \my $quiet,
     'help'      => \my $help,
+    'tlibs'      => \my $t_libs,
 );
 
+if ($t_libs) {
+    unshift( @INC, 't/lib', 'lib' );
+}
+
 pod2usage(1) if ($help);
 $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} = 1 if ($trace);
 
@@ -44,7 +50,10 @@ if ($op eq 'select') {
 die('No schema specified') if(!$schema_class);
 eval("require $schema_class");
 die('Unable to load schema') if ($@);
-my $schema = $schema_class->connect();
+$connect = jsonToObj( $connect ) if ($connect);
+my $schema = $schema_class->connect(
+    ( $connect ? @$connect : () )
+);
 
 die('No class specified') if(!$resultset_class);
 my $resultset = eval{ $schema->resultset($resultset_class) };
@@ -137,6 +146,12 @@ The name of your schema class.
 The name of the class, within your schema, that you want to run 
 the operation on.
 
+=head2 connect
+
+A JSON array to be passed to your schema class upon connecting.  
+The array will need to be compatible with whatever the DBIC 
+->connect() method requires.
+
 =head2 set
 
 This option must be valid JSON data string and is passed in to 
@@ -173,6 +188,11 @@ Do not display status messages.
 Turns on tracing on the DBI storage, thus printing SQL as it is 
 executed.
 
+=head2 tlibs
+
+This option is purely for testing during the DBIC installation.  Do 
+not use it.
+
 =head1 JSON
 
 JSON is a lightweight data-interchange format.  It allows you 
diff --git a/t/helperrels/29dbicadmin.t b/t/helperrels/29dbicadmin.t
new file mode 100644 (file)
index 0000000..ea5882e
--- /dev/null
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/29dbicadmin.tl";
+run_tests(DBICTest->schema);
diff --git a/t/run/29dbicadmin.tl b/t/run/29dbicadmin.tl
new file mode 100644 (file)
index 0000000..354967c
--- /dev/null
@@ -0,0 +1,38 @@
+# vim: filetype=perl
+
+sub run_tests {
+
+    eval{'require JSON'};
+    plan skip_all, 'Install JSON to run this test' if ($@);
+
+    eval{'require Text::CSV_XS'};
+    if ($@) {
+        eval{'require Text::CSV_PP'};
+        plan skip_all, 'Install Text::CSV_XS or Text::CSV_PP to run this test' if ($@);
+    }
+
+    plan tests => 5;
+    my $schema = shift;
+
+    my $employees = $schema->resultset('Employee');
+    my $cmd = qq|scripts/dbicadmin --schema=DBICTest::Schema --class=Employee --tlibs --connect='["dbi:SQLite:dbname=t/var/DBIxClass.db","",""]' --force --tlibs|;
+
+    `$cmd --op=insert --set='{name:"Matt"}'`;
+    ok( ($employees->count()==1), 'insert count' );
+
+    my $employee = $employees->find(1);
+    ok( ($employee->name() eq 'Matt'), 'insert valid' );
+
+    `$cmd --op=update --set='{name:"Trout"}'`;
+    $employee = $employees->find(1);
+    ok( ($employee->name() eq 'Trout'), 'update' );
+
+    `$cmd --op=insert --set='{name:"Aran"}'`;
+    my $data = `$cmd --op=select --attrs='{order_by:"name"}'`;
+    ok( ($data=~/Aran.*Trout/s), 'select with attrs' );
+
+    `$cmd --op=delete --where='{name:"Trout"}'`;
+    ok( ($employees->count()==1), 'delete' );
+}
+
+1;