Merge 'trunk' into 'type_aware_update'
[dbsrgits/DBIx-Class.git] / script / dbicadmin
CommitLineData
a94aa524 1#!/usr/bin/perl
2use strict;
3use warnings;
4
5use Getopt::Long;
6use Pod::Usage;
c843f5e4 7use JSON::Any;
a94aa524 8
8cfef6f5 9
10my $json = JSON::Any->new(allow_barekey => 1, allow_singlequote => 1);
6717e3a8 11
2bbc85c9 12GetOptions(
13 'schema=s' => \my $schema_class,
14 'class=s' => \my $resultset_class,
d8d6276a 15 'connect=s' => \my $connect,
2bbc85c9 16 'op=s' => \my $op,
17 'set=s' => \my $set,
6717e3a8 18 'where=s' => \my $where,
19 'attrs=s' => \my $attrs,
b04e5d3e 20 'format=s' => \my $format,
2bbc85c9 21 'force' => \my $force,
5deea98c 22 'trace' => \my $trace,
2bbc85c9 23 'quiet' => \my $quiet,
24 'help' => \my $help,
d8d6276a 25 'tlibs' => \my $t_libs,
2bbc85c9 26);
a94aa524 27
d8d6276a 28if ($t_libs) {
29 unshift( @INC, 't/lib', 'lib' );
30}
31
2bbc85c9 32pod2usage(1) if ($help);
5deea98c 33$ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} = 1 if ($trace);
a94aa524 34
b04e5d3e 35die('No op specified') if(!$op);
36die('Invalid op') if ($op!~/^insert|update|delete|select$/s);
37my $csv_class;
38if ($op eq 'select') {
39 $format ||= 'tsv';
40 die('Invalid format') if ($format!~/^tsv|csv$/s);
41 $csv_class = 'Text::CSV_XS';
42 eval{ require Text::CSV_XS };
43 if ($@) {
44 $csv_class = 'Text::CSV_PP';
45 eval{ require Text::CSV_PP };
46 die('The select op requires either the Text::CSV_XS or the Text::CSV_PP module') if ($@);
47 }
48}
a94aa524 49
b04e5d3e 50die('No schema specified') if(!$schema_class);
a94aa524 51eval("require $schema_class");
2bbc85c9 52die('Unable to load schema') if ($@);
8cfef6f5 53$connect = $json->jsonToObj( $connect ) if ($connect);
d8d6276a 54my $schema = $schema_class->connect(
55 ( $connect ? @$connect : () )
56);
a94aa524 57
b04e5d3e 58die('No class specified') if(!$resultset_class);
2bbc85c9 59my $resultset = eval{ $schema->resultset($resultset_class) };
a94aa524 60die('Unable to load the class with the schema') if ($@);
61
8cfef6f5 62$set = $json->jsonToObj( $set ) if ($set);
63$where = $json->jsonToObj( $where ) if ($where);
64$attrs = $json->jsonToObj( $attrs ) if ($attrs);
a94aa524 65
66if ($op eq 'insert') {
b04e5d3e 67 die('Do not use the where option with the insert op') if ($where);
6717e3a8 68 die('Do not use the attrs option with the insert op') if ($attrs);
a94aa524 69 my $obj = $resultset->create( $set );
81a40c3d 70 print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$quiet);
a94aa524 71}
72elsif ($op eq 'update') {
3e6fb102 73 $resultset = $resultset->search( ($where||{}) );
a94aa524 74 my $count = $resultset->count();
2bbc85c9 75 print "This action will modify $count ".ref($resultset)." records.\n" if (!$quiet);
a94aa524 76 if ( $force || confirm() ) {
77 $resultset->update_all( $set );
78 }
79}
80elsif ($op eq 'delete') {
b04e5d3e 81 die('Do not use the set option with the delete op') if ($set);
3e6fb102 82 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
a94aa524 83 my $count = $resultset->count();
2bbc85c9 84 print "This action will delete $count ".ref($resultset)." records.\n" if (!$quiet);
a94aa524 85 if ( $force || confirm() ) {
86 $resultset->delete_all();
87 }
88}
b04e5d3e 89elsif ($op eq 'select') {
90 die('Do not use the set option with the select op') if ($set);
91 my $csv = $csv_class->new({
92 sep_char => ( $format eq 'tsv' ? "\t" : ',' ),
93 });
3e6fb102 94 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
b04e5d3e 95 my @columns = $resultset->result_source->columns();
96 $csv->combine( @columns );
5deea98c 97 print $csv->string()."\n";
b04e5d3e 98 while (my $row = $resultset->next()) {
99 my @fields;
100 foreach my $column (@columns) {
101 push( @fields, $row->get_column($column) );
102 }
103 $csv->combine( @fields );
5deea98c 104 print $csv->string()."\n";
b04e5d3e 105 }
106}
a94aa524 107
108sub confirm {
109 print "Are you sure you want to do this? (type YES to confirm) ";
110 my $response = <STDIN>;
111 return 1 if ($response=~/^YES/);
112 return;
113}
114
115__END__
116
117=head1 NAME
118
5deea98c 119dbicadmin - Execute operations upon DBIx::Class objects.
a94aa524 120
121=head1 SYNOPSIS
122
b04e5d3e 123 dbicadmin --op=insert --schema=My::Schema --class=Class --set=JSON
124 dbicadmin --op=update --schema=My::Schema --class=Class --set=JSON --where=JSON
125 dbicadmin --op=delete --schema=My::Schema --class=Class --where=JSON
126 dbicadmin --op=select --schema=My::Schema --class=Class --where=JSON --format=tsv
a94aa524 127
128=head1 DESCRIPTION
129
b04e5d3e 130This utility provides the ability to run INSERTs, UPDATEs,
131DELETEs, and SELECTs on any DBIx::Class object.
a94aa524 132
b04e5d3e 133=head1 OPTIONS
a94aa524 134
b04e5d3e 135=head2 op
a94aa524 136
b04e5d3e 137The type of operation. Valid values are insert, update, delete,
138and select.
a94aa524 139
140=head2 schema
141
142The name of your schema class.
143
144=head2 class
145
146The name of the class, within your schema, that you want to run
147the operation on.
148
d8d6276a 149=head2 connect
150
151A JSON array to be passed to your schema class upon connecting.
152The array will need to be compatible with whatever the DBIC
153->connect() method requires.
154
6717e3a8 155=head2 set
156
157This option must be valid JSON data string and is passed in to
158the DBIC update() method. Use this option with the update
159and insert ops.
160
b04e5d3e 161=head2 where
162
6717e3a8 163This option must be valid JSON data string and is passed in as
164the first argument to the DBIC search() method. Use this
165option with the update, delete, and select ops.
b04e5d3e 166
6717e3a8 167=head2 attrs
b04e5d3e 168
6717e3a8 169This option must be valid JSON data string and is passed in as
170the second argument to the DBIC search() method. Use this
171option with the update, delete, and select ops.
a94aa524 172
173=head2 help
174
175Display this help page.
176
177=head2 force
178
179Suppresses the confirmation dialogues that are usually displayed
180when someone runs a DELETE or UPDATE action.
181
2bbc85c9 182=head2 quiet
183
5deea98c 184Do not display status messages.
185
186=head2 trace
187
188Turns on tracing on the DBI storage, thus printing SQL as it is
189executed.
2bbc85c9 190
d8d6276a 191=head2 tlibs
192
193This option is purely for testing during the DBIC installation. Do
194not use it.
195
6717e3a8 196=head1 JSON
197
198JSON is a lightweight data-interchange format. It allows you
199to express complex data structures for use in the where and
200set options.
201
202This module turns on L<JSON>'s BareKey and QuotApos options so
203that your data can look a bit more readable.
204
205 --where={"this":"that"} # generic JSON
206 --where={this:'that'} # with BareKey and QuoteApos
207
208Consider wrapping your JSON in outer quotes so that you don't
209have to escape your inner quotes.
210
211 --where={this:\"that\"} # no outer quote
212 --where='{this:"that"}' # outer quoted
213
a94aa524 214=head1 AUTHOR
215
216Aran Deltac <bluefeet@cpan.org>
217
218=head1 LICENSE
219
220You may distribute this code under the same terms as Perl itself.
221