From: Aran Deltac Date: Thu, 27 Apr 2006 01:36:52 +0000 (+0000) Subject: New dbicadmin script for bringing dbic objects to the unix command line. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a94aa5248ef599ca2bd8006bc7d3e7642121d4e5;p=dbsrgits%2FDBIx-Class-Historic.git New dbicadmin script for bringing dbic objects to the unix command line. --- diff --git a/maint/dbicadmin b/maint/dbicadmin new file mode 100755 index 0000000..fbad47e --- /dev/null +++ b/maint/dbicadmin @@ -0,0 +1,141 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Getopt::Long; +use Pod::Usage; +use IO::File; + +$ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} = 1; + +pod2usage(1) if (@ARGV<3); + +my $op = shift(@ARGV); +die('First argument must be insert, update, or delete') if ($op!~/^insert|update|delete$/s); + +my $schema_class = shift(@ARGV); +eval("require $schema_class"); +die('Unable to load schema module') if ($@); +my $schema = $schema_class->connect(); + +my $class = shift(@ARGV); +my $resultset = eval{ $schema->resultset($class) }; +die('Unable to load the class with the schema') if ($@); + +my $where = {}; +my $set = {}; + +GetOptions( + 'where=s' => $where, + 'set=s' => $set, + 'force' => \my $force, + 'help' => \my $help, +); + +pod2usage(1) if ($help); + +if ($op eq 'insert') { + die('The insert operator and the where option do not mix') if (%$where); + my $obj = $resultset->create( $set ); + print "$schema_class\::$class ID: ".join(',',$obj->id())."\n"; +} +elsif ($op eq 'update') { + $resultset = $resultset->search( $where ); + my $count = $resultset->count(); + print "This action will modify $count $schema_class\::$class records.\n"; + if ( $force || confirm() ) { + $resultset->update_all( $set ); + } +} +elsif ($op eq 'delete') { + die('The delete operator and the set option do not mix') if (%$set); + $resultset = $resultset->search( $where ); + my $count = $resultset->count(); + print "This action will delete $count $schema_class\::$class records.\n"; + if ( $force || confirm() ) { + $resultset->delete_all(); + } +} + +sub confirm { + print "Are you sure you want to do this? (type YES to confirm) "; + my $response = ; + return 1 if ($response=~/^YES/); + return; +} + +__END__ + +=head1 NAME + +dbicadmin - Execute simple actions upon DBIx::Class objects. + +=head1 SYNOPSIS + + dbicadmin insert My::Schema Class --set this=that + dbicadmin update My::Schema Class --set this=that --where those=these + dbicadmin delete My::Schema Class --where those=these + +=head1 DESCRIPTION + +This utility provides the ability to run INSERTs, UPDATEs, and +DELETEs on any DBIx::Class object. + +=head1 ARGUMENTS + +Before any options are passed this script expects three arguments. + +=head2 operation + +The type of operation. Valid values are insert, update, and delete. + +=head2 schema + +The name of your schema class. + +=head2 class + +The name of the class, within your schema, that you want to run +the operation on. + +=head1 OPTIONS + +=head2 help + +Display this help page. + +=head2 force + +Suppresses the confirmation dialogues that are usually displayed +when someone runs a DELETE or UPDATE action. + +=head2 where + +This option uses L's ability to specify a hash +structure with command line options. Basically, for every +clause that you want to include in the WHERE statement you +have a --where option specifying the clause. So, if you wanted +to specify two clauses you would do: + + --where this=that --where those=these + +And that will become something like: + + WHERE this="that" AND those="these" + +The insert does not suppor the where option and will croak if +you try to use it. + +=head2 set + +This works just like the where option except that the insert +operation does support it, but the delete operation does not. + +=head1 AUTHOR + +Aran Deltac + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. +