7 use JSON qw( jsonToObj );
13 'schema=s' => \my $schema_class,
14 'class=s' => \my $resultset_class,
17 'where=s' => \my $where,
18 'attrs=s' => \my $attrs,
19 'format=s' => \my $format,
20 'force' => \my $force,
21 'trace' => \my $trace,
22 'quiet' => \my $quiet,
26 pod2usage(1) if ($help);
27 $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} = 1 if ($trace);
29 die('No op specified') if(!$op);
30 die('Invalid op') if ($op!~/^insert|update|delete|select$/s);
32 if ($op eq 'select') {
34 die('Invalid format') if ($format!~/^tsv|csv$/s);
35 $csv_class = 'Text::CSV_XS';
36 eval{ require Text::CSV_XS };
38 $csv_class = 'Text::CSV_PP';
39 eval{ require Text::CSV_PP };
40 die('The select op requires either the Text::CSV_XS or the Text::CSV_PP module') if ($@);
44 die('No schema specified') if(!$schema_class);
45 eval("require $schema_class");
46 die('Unable to load schema') if ($@);
47 my $schema = $schema_class->connect();
49 die('No class specified') if(!$resultset_class);
50 my $resultset = eval{ $schema->resultset($resultset_class) };
51 die('Unable to load the class with the schema') if ($@);
53 $set = jsonToObj( $set ) if ($set);
54 $where = jsonToObj( $where ) if ($where);
55 $attrs = jsonToObj( $attrs ) if ($attrs);
57 if ($op eq 'insert') {
58 die('Do not use the where option with the insert op') if ($where);
59 die('Do not use the attrs option with the insert op') if ($attrs);
60 my $obj = $resultset->create( $set );
61 print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n";
63 elsif ($op eq 'update') {
64 $resultset = $resultset->search( $where );
65 my $count = $resultset->count();
66 print "This action will modify $count ".ref($resultset)." records.\n" if (!$quiet);
67 if ( $force || confirm() ) {
68 $resultset->update_all( $set );
71 elsif ($op eq 'delete') {
72 die('Do not use the set option with the delete op') if ($set);
73 $resultset = $resultset->search( $where, $attrs );
74 my $count = $resultset->count();
75 print "This action will delete $count ".ref($resultset)." records.\n" if (!$quiet);
76 if ( $force || confirm() ) {
77 $resultset->delete_all();
80 elsif ($op eq 'select') {
81 die('Do not use the set option with the select op') if ($set);
82 my $csv = $csv_class->new({
83 sep_char => ( $format eq 'tsv' ? "\t" : ',' ),
85 $resultset = $resultset->search( $where, $attrs );
86 my @columns = $resultset->result_source->columns();
87 $csv->combine( @columns );
88 print $csv->string()."\n";
89 while (my $row = $resultset->next()) {
91 foreach my $column (@columns) {
92 push( @fields, $row->get_column($column) );
94 $csv->combine( @fields );
95 print $csv->string()."\n";
100 print "Are you sure you want to do this? (type YES to confirm) ";
101 my $response = <STDIN>;
102 return 1 if ($response=~/^YES/);
110 dbicadmin - Execute operations upon DBIx::Class objects.
114 dbicadmin --op=insert --schema=My::Schema --class=Class --set=JSON
115 dbicadmin --op=update --schema=My::Schema --class=Class --set=JSON --where=JSON
116 dbicadmin --op=delete --schema=My::Schema --class=Class --where=JSON
117 dbicadmin --op=select --schema=My::Schema --class=Class --where=JSON --format=tsv
121 This utility provides the ability to run INSERTs, UPDATEs,
122 DELETEs, and SELECTs on any DBIx::Class object.
128 The type of operation. Valid values are insert, update, delete,
133 The name of your schema class.
137 The name of the class, within your schema, that you want to run
142 This option must be valid JSON data string and is passed in to
143 the DBIC update() method. Use this option with the update
148 This option must be valid JSON data string and is passed in as
149 the first argument to the DBIC search() method. Use this
150 option with the update, delete, and select ops.
154 This option must be valid JSON data string and is passed in as
155 the second argument to the DBIC search() method. Use this
156 option with the update, delete, and select ops.
160 Display this help page.
164 Suppresses the confirmation dialogues that are usually displayed
165 when someone runs a DELETE or UPDATE action.
169 Do not display status messages.
173 Turns on tracing on the DBI storage, thus printing SQL as it is
178 JSON is a lightweight data-interchange format. It allows you
179 to express complex data structures for use in the where and
182 This module turns on L<JSON>'s BareKey and QuotApos options so
183 that your data can look a bit more readable.
185 --where={"this":"that"} # generic JSON
186 --where={this:'that'} # with BareKey and QuoteApos
188 Consider wrapping your JSON in outer quotes so that you don't
189 have to escape your inner quotes.
191 --where={this:\"that\"} # no outer quote
192 --where='{this:"that"}' # outer quoted
196 Aran Deltac <bluefeet@cpan.org>
200 You may distribute this code under the same terms as Perl itself.