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, |
12 | 'where=s' => \my $where, |
13 | 'op=s' => \my $op, |
14 | 'set=s' => \my $set, |
15 | 'force' => \my $force, |
16 | 'quiet' => \my $quiet, |
17 | 'help' => \my $help, |
18 | ); |
a94aa524 |
19 | |
2bbc85c9 |
20 | pod2usage(1) if ($help); |
21 | $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} = 1 if (!$quiet); |
a94aa524 |
22 | |
2bbc85c9 |
23 | die('Invalid op') if ($op!~/^insert|update|delete$/s); |
a94aa524 |
24 | |
a94aa524 |
25 | eval("require $schema_class"); |
2bbc85c9 |
26 | die('Unable to load schema') if ($@); |
a94aa524 |
27 | my $schema = $schema_class->connect(); |
28 | |
2bbc85c9 |
29 | my $resultset = eval{ $schema->resultset($resultset_class) }; |
a94aa524 |
30 | die('Unable to load the class with the schema') if ($@); |
31 | |
2bbc85c9 |
32 | $where = jsonToObj( $where ) if ($where); |
33 | $set = jsonToObj( $set ) if ($set); |
a94aa524 |
34 | |
35 | if ($op eq 'insert') { |
2bbc85c9 |
36 | die('The insert operator and the where option do not mix') if ($where); |
a94aa524 |
37 | my $obj = $resultset->create( $set ); |
2bbc85c9 |
38 | print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n"; |
a94aa524 |
39 | } |
40 | elsif ($op eq 'update') { |
41 | $resultset = $resultset->search( $where ); |
42 | my $count = $resultset->count(); |
2bbc85c9 |
43 | print "This action will modify $count ".ref($resultset)." records.\n" if (!$quiet); |
a94aa524 |
44 | if ( $force || confirm() ) { |
45 | $resultset->update_all( $set ); |
46 | } |
47 | } |
48 | elsif ($op eq 'delete') { |
2bbc85c9 |
49 | die('The delete operator and the set option do not mix') if ($set); |
a94aa524 |
50 | $resultset = $resultset->search( $where ); |
51 | my $count = $resultset->count(); |
2bbc85c9 |
52 | print "This action will delete $count ".ref($resultset)." records.\n" if (!$quiet); |
a94aa524 |
53 | if ( $force || confirm() ) { |
54 | $resultset->delete_all(); |
55 | } |
56 | } |
57 | |
58 | sub confirm { |
59 | print "Are you sure you want to do this? (type YES to confirm) "; |
60 | my $response = <STDIN>; |
61 | return 1 if ($response=~/^YES/); |
62 | return; |
63 | } |
64 | |
65 | __END__ |
66 | |
67 | =head1 NAME |
68 | |
69 | dbicadmin - Execute simple actions upon DBIx::Class objects. |
70 | |
71 | =head1 SYNOPSIS |
72 | |
73 | dbicadmin insert My::Schema Class --set this=that |
74 | dbicadmin update My::Schema Class --set this=that --where those=these |
75 | dbicadmin delete My::Schema Class --where those=these |
76 | |
77 | =head1 DESCRIPTION |
78 | |
79 | This utility provides the ability to run INSERTs, UPDATEs, and |
80 | DELETEs on any DBIx::Class object. |
81 | |
82 | =head1 ARGUMENTS |
83 | |
84 | Before any options are passed this script expects three arguments. |
85 | |
86 | =head2 operation |
87 | |
88 | The type of operation. Valid values are insert, update, and delete. |
89 | |
90 | =head2 schema |
91 | |
92 | The name of your schema class. |
93 | |
94 | =head2 class |
95 | |
96 | The name of the class, within your schema, that you want to run |
97 | the operation on. |
98 | |
99 | =head1 OPTIONS |
100 | |
101 | =head2 help |
102 | |
103 | Display this help page. |
104 | |
105 | =head2 force |
106 | |
107 | Suppresses the confirmation dialogues that are usually displayed |
108 | when someone runs a DELETE or UPDATE action. |
109 | |
2bbc85c9 |
110 | =head2 quiet |
111 | |
112 | Do not print status messages or SQL statements. |
113 | |
a94aa524 |
114 | =head2 where |
115 | |
116 | This option uses L<Getopt::Long>'s ability to specify a hash |
117 | structure with command line options. Basically, for every |
118 | clause that you want to include in the WHERE statement you |
119 | have a --where option specifying the clause. So, if you wanted |
120 | to specify two clauses you would do: |
121 | |
122 | --where this=that --where those=these |
123 | |
124 | And that will become something like: |
125 | |
126 | WHERE this="that" AND those="these" |
127 | |
128 | The insert does not suppor the where option and will croak if |
129 | you try to use it. |
130 | |
131 | =head2 set |
132 | |
133 | This works just like the where option except that the insert |
134 | operation does support it, but the delete operation does not. |
135 | |
136 | =head1 AUTHOR |
137 | |
138 | Aran Deltac <bluefeet@cpan.org> |
139 | |
140 | =head1 LICENSE |
141 | |
142 | You may distribute this code under the same terms as Perl itself. |
143 | |