From: Aran Deltac Date: Sun, 30 Apr 2006 15:37:09 +0000 (+0000) Subject: Tests for dbicadmin. X-Git-Tag: v0.07002~75^2~219 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d8d6276aff8e34b08257a0fc440aa402161e79cf;p=dbsrgits%2FDBIx-Class.git Tests for dbicadmin. --- diff --git a/maint/dbicadmin b/scripts/dbicadmin similarity index 91% rename from maint/dbicadmin rename to scripts/dbicadmin index 0f49332..e873745 100755 --- a/maint/dbicadmin +++ b/scripts/dbicadmin @@ -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 index 0000000..ea5882e --- /dev/null +++ b/t/helperrels/29dbicadmin.t @@ -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 index 0000000..354967c --- /dev/null +++ b/t/run/29dbicadmin.tl @@ -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;