Commit | Line | Data |
a94aa524 |
1 | #!/usr/bin/perl |
2 | use strict; |
3 | use warnings; |
4 | |
5 | use Getopt::Long; |
6 | use Pod::Usage; |
2bbc85c9 |
7 | use JSON qw( jsonToObj ); |
a94aa524 |
8 | |
2bbc85c9 |
9 | GetOptions( |
10 | 'schema=s' => \my $schema_class, |
11 | 'class=s' => \my $resultset_class, |
2bbc85c9 |
12 | 'op=s' => \my $op, |
b04e5d3e |
13 | 'where=s' => \my $where, |
2bbc85c9 |
14 | 'set=s' => \my $set, |
b04e5d3e |
15 | 'format=s' => \my $format, |
2bbc85c9 |
16 | 'force' => \my $force, |
17 | 'quiet' => \my $quiet, |
18 | 'help' => \my $help, |
19 | ); |
a94aa524 |
20 | |
2bbc85c9 |
21 | pod2usage(1) if ($help); |
22 | $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} = 1 if (!$quiet); |
a94aa524 |
23 | |
b04e5d3e |
24 | die('No op specified') if(!$op); |
25 | die('Invalid op') if ($op!~/^insert|update|delete|select$/s); |
26 | my $csv_class; |
27 | if ($op eq 'select') { |
28 | $format ||= 'tsv'; |
29 | die('Invalid format') if ($format!~/^tsv|csv$/s); |
30 | $csv_class = 'Text::CSV_XS'; |
31 | eval{ require Text::CSV_XS }; |
32 | if ($@) { |
33 | $csv_class = 'Text::CSV_PP'; |
34 | eval{ require Text::CSV_PP }; |
35 | die('The select op requires either the Text::CSV_XS or the Text::CSV_PP module') if ($@); |
36 | } |
37 | } |
a94aa524 |
38 | |
b04e5d3e |
39 | die('No schema specified') if(!$schema_class); |
a94aa524 |
40 | eval("require $schema_class"); |
2bbc85c9 |
41 | die('Unable to load schema') if ($@); |
a94aa524 |
42 | my $schema = $schema_class->connect(); |
43 | |
b04e5d3e |
44 | die('No class specified') if(!$resultset_class); |
2bbc85c9 |
45 | my $resultset = eval{ $schema->resultset($resultset_class) }; |
a94aa524 |
46 | die('Unable to load the class with the schema') if ($@); |
47 | |
2bbc85c9 |
48 | $where = jsonToObj( $where ) if ($where); |
49 | $set = jsonToObj( $set ) if ($set); |
a94aa524 |
50 | |
51 | if ($op eq 'insert') { |
b04e5d3e |
52 | die('Do not use the where option with the insert op') if ($where); |
a94aa524 |
53 | my $obj = $resultset->create( $set ); |
2bbc85c9 |
54 | print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n"; |
a94aa524 |
55 | } |
56 | elsif ($op eq 'update') { |
57 | $resultset = $resultset->search( $where ); |
58 | my $count = $resultset->count(); |
2bbc85c9 |
59 | print "This action will modify $count ".ref($resultset)." records.\n" if (!$quiet); |
a94aa524 |
60 | if ( $force || confirm() ) { |
61 | $resultset->update_all( $set ); |
62 | } |
63 | } |
64 | elsif ($op eq 'delete') { |
b04e5d3e |
65 | die('Do not use the set option with the delete op') if ($set); |
a94aa524 |
66 | $resultset = $resultset->search( $where ); |
67 | my $count = $resultset->count(); |
2bbc85c9 |
68 | print "This action will delete $count ".ref($resultset)." records.\n" if (!$quiet); |
a94aa524 |
69 | if ( $force || confirm() ) { |
70 | $resultset->delete_all(); |
71 | } |
72 | } |
b04e5d3e |
73 | elsif ($op eq 'select') { |
74 | die('Do not use the set option with the select op') if ($set); |
75 | my $csv = $csv_class->new({ |
76 | sep_char => ( $format eq 'tsv' ? "\t" : ',' ), |
77 | }); |
78 | $resultset = $resultset->search( $where ); |
79 | my @columns = $resultset->result_source->columns(); |
80 | $csv->combine( @columns ); |
81 | print $csv->string(); |
82 | while (my $row = $resultset->next()) { |
83 | my @fields; |
84 | foreach my $column (@columns) { |
85 | push( @fields, $row->get_column($column) ); |
86 | } |
87 | $csv->combine( @fields ); |
88 | print $csv->string(); |
89 | } |
90 | } |
a94aa524 |
91 | |
92 | sub confirm { |
93 | print "Are you sure you want to do this? (type YES to confirm) "; |
94 | my $response = <STDIN>; |
95 | return 1 if ($response=~/^YES/); |
96 | return; |
97 | } |
98 | |
99 | __END__ |
100 | |
101 | =head1 NAME |
102 | |
103 | dbicadmin - Execute simple actions upon DBIx::Class objects. |
104 | |
105 | =head1 SYNOPSIS |
106 | |
b04e5d3e |
107 | dbicadmin --op=insert --schema=My::Schema --class=Class --set=JSON |
108 | dbicadmin --op=update --schema=My::Schema --class=Class --set=JSON --where=JSON |
109 | dbicadmin --op=delete --schema=My::Schema --class=Class --where=JSON |
110 | dbicadmin --op=select --schema=My::Schema --class=Class --where=JSON --format=tsv |
a94aa524 |
111 | |
112 | =head1 DESCRIPTION |
113 | |
b04e5d3e |
114 | This utility provides the ability to run INSERTs, UPDATEs, |
115 | DELETEs, and SELECTs on any DBIx::Class object. |
a94aa524 |
116 | |
b04e5d3e |
117 | =head1 OPTIONS |
a94aa524 |
118 | |
b04e5d3e |
119 | =head2 op |
a94aa524 |
120 | |
b04e5d3e |
121 | The type of operation. Valid values are insert, update, delete, |
122 | and select. |
a94aa524 |
123 | |
124 | =head2 schema |
125 | |
126 | The name of your schema class. |
127 | |
128 | =head2 class |
129 | |
130 | The name of the class, within your schema, that you want to run |
131 | the operation on. |
132 | |
b04e5d3e |
133 | =head2 where |
134 | |
135 | A valid JSON data string that is compatible with DBIC. |
136 | |
137 | =head2 set |
138 | |
139 | A valid JSON data stream that is compatible with DBIC. |
a94aa524 |
140 | |
141 | =head2 help |
142 | |
143 | Display this help page. |
144 | |
145 | =head2 force |
146 | |
147 | Suppresses the confirmation dialogues that are usually displayed |
148 | when someone runs a DELETE or UPDATE action. |
149 | |
2bbc85c9 |
150 | =head2 quiet |
151 | |
152 | Do not print status messages or SQL statements. |
153 | |
a94aa524 |
154 | =head1 AUTHOR |
155 | |
156 | Aran Deltac <bluefeet@cpan.org> |
157 | |
158 | =head1 LICENSE |
159 | |
160 | You may distribute this code under the same terms as Perl itself. |
161 | |