add compatability for --op for dbicadmin, revert test suite
Gordon Irving [Sat, 12 Dec 2009 21:34:35 +0000 (21:34 +0000)]
lib/DBIx/Class/Admin.pm
script/dbicadmin
t/89dbicadmin.t

index 4023d61..03238e1 100644 (file)
@@ -51,31 +51,6 @@ coerce DBICConnectInfo,
 coerce DBICConnectInfo,
        from HashRef,
         via { [ $_->{dsn}, $_->{user}, $_->{password} ]  };
-#
-#              ['lib|I:s' => 'Additonal library path to search in'], 
-#              ['schema|s:s' => 'The class of the schema to load', { required => 1 } ],
-#              ['config-stanza|S:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',],
-#              ['config|C:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ],
-#              ['connect-info|n:s%' => ' supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> '],
-#              ['sql-dir|q:s' => 'The directory where sql diffs will be created'],
-#              ['sql-type|t:s' => 'The RDBMs falvour you wish to use'],
-#              ['version|v:i' => 'Supply a version install'],
-#              ['preversion|p:s' => 'The previous version to diff against',],
-#
-#    '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,
-#    'attrs=s'   => \my $attrs,
-#    'format=s'  => \my $format,
-#    'force'     => \my $force,
-#    'trace'     => \my $trace,
-#    'quiet'     => \my $quiet,
-#    'help'      => \my $help,
-#    'tlibs'      => \my $t_libs,
-#=cut
 
 =head1 NAME
 
@@ -287,7 +262,7 @@ has force => (
        isa                     => 'Bool',
 );
 
-=head2 quite
+=head2 quiet
 
 Be less verbose about actions
 =cut
index 356b537..061f145 100755 (executable)
@@ -20,11 +20,12 @@ my ($opts, $usage) = describe_options(
                        ['create|c' => 'Create version diffs needs preversion',],
                        ['upgrade|u' => 'Upgrade the database to the current schema '],
                        ['install|i' => 'Install the schema to the database',],
-                       ['deploy|d' => 'Deploy the schema to the database',],
+                       ['deploy|d' => 'Deploy the a to the database',],
                        ['select|s'   => 'Select data from the schema', ],
                        ['insert|i'   => 'Insert data into the schema', ],
                        ['update|u'   => 'Update data in the schema', ], 
                        ['delete|D'   => 'Delete data from the schema',],
+                       ['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'],
                        ['help|h' => 'display this help'],
                ], required=> 1 }],
                ['Options'],
@@ -70,9 +71,11 @@ my $admin = DBIx::Class::Admin->new( %$opts );
 
 
 my $action = $opts->{action};
-print "going to perform action $action\n";
+
+$action = $opts->{op} if ($action eq 'op');
 my $res = $admin->$action();
 
+print "going to perform action $action\n";
 if ($action eq 'select') {
 
        my $csv_class;
index 0baaacd..0a9666b 100644 (file)
@@ -38,22 +38,22 @@ sub test_dbicadmin {
 
     my $employees = $schema->resultset('Employee');
 
-    system( _prepare_system_args( qw|--insert --set={"name":"Matt"}| ) );
+    system( _prepare_system_args( qw|--op=insert --set={"name":"Matt"}| ) );
     ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: insert count" );
 
     my $employee = $employees->find(1);
     ok( ($employee->name() eq 'Matt'), "$ENV{JSON_ANY_ORDER}: insert valid" );
 
-    system( _prepare_system_args( qw|--update --set={"name":"Trout"}| ) );
+    system( _prepare_system_args( qw|--op=update --set={"name":"Trout"}| ) );
     $employee = $employees->find(1);
     ok( ($employee->name() eq 'Trout'), "$ENV{JSON_ANY_ORDER}: update" );
 
-    system( _prepare_system_args( qw|--insert --set={"name":"Aran"}| ) );
+    system( _prepare_system_args( qw|--op=insert --set={"name":"Aran"}| ) );
 
     SKIP: {
         skip ("MSWin32 doesn't support -| either", 1) if $^O eq 'MSWin32';
 
-        open(my $fh, "-|",  _prepare_system_args( qw|--select --attrs={"order_by":"name"}| ) ) or die $!;
+        open(my $fh, "-|",  _prepare_system_args( qw|--op=select --attrs={"order_by":"name"}| ) ) or die $!;
         my $data = do { local $/; <$fh> };
         close($fh);
         if (!ok( ($data=~/Aran.*Trout/s), "$ENV{JSON_ANY_ORDER}: select with attrs" )) {
@@ -61,7 +61,7 @@ sub test_dbicadmin {
                };
     }
 
-    system( _prepare_system_args( qw|--delete --where={"name":"Trout"}| ) );
+    system( _prepare_system_args( qw|--op=delete --where={"name":"Trout"}| ) );
     ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: delete" );
 }