1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6BEGIN {
7  use DBIx::Class;
8  die (  'The following modules are required for the dbicadmin utility: '
9       . DBIx::Class::Optional::Dependencies->req_missing_for ('admin_script')
10       . "\n"
11  ) unless DBIx::Class::Optional::Dependencies->req_ok_for ('admin_script');
12}
13
14use DBIx::Class::Admin::Descriptive;
15#use Getopt::Long::Descriptive;
16use DBIx::Class::Admin;
17
18my $short_description = "utility for administrating DBIx::Class schemata";
19my $synopsis_text =q|
20  deploy a schema to a database
21  %c --schema=MyApp::Schema \
22    --connect='["dbi:SQLite:my.db", "", ""]' \
23    --deploy
24
25  update an existing record
26  %c --schema=MyApp::Schema --class=Employee \
27    --connect='["dbi:SQLite:my.db", "", ""]' \
28    --op=update --set='{ "name": "New_Employee" }'
29|;
30
31my ($opts, $usage) = describe_options(
32    "%c: %o",
33  (
34    ['Actions'],
35    ["action" => hidden => { one_of => [
36      ['create' => 'Create version diffs needs preversion',],
37      ['upgrade' => 'Upgrade the database to the current schema '],
38      ['install' => 'Install the schema version tables to an existing database',],
39      ['deploy' => 'Deploy the schema to the database',],
40      ['select'   => 'Select data from the schema', ],
41      ['insert'   => 'Insert data into the schema', ],
42      ['update'   => 'Update data in the schema', ], 
43      ['delete'   => 'Delete data from the schema',],
44      ['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'],
45      ['help' => 'display this help', { implies => { schema_class => '__dummy__' } } ],
46      ['selfinject-pod' => 'hidden', { implies => { schema_class => '__dummy__' } } ],
47    ], required=> 1 }],
48    ['Arguments'],
49    ['schema-class:s' => 'The class of the schema to load', { required => 1 } ],
50    ['resultset|resultset-class|class:s' => 'The resultset to operate on for data manipulation' ],
51    ['config-stanza:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',],
52    ['config:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ],
53    ['connect-info:s%' => 'Supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> '],
54    ['connect:s' => 'Supply the connect info as a json string' ],
55    ['sql-dir:s' => 'The directory where sql diffs will be created'],
56    ['sql-type:s' => 'The RDBMs flavour you wish to use'],
57    ['version:i' => 'Supply a version install'],
58    ['preversion:s' => 'The previous version to diff against',],
59    ['set:s' => 'JSON data used to perform data operations' ],
60    ['attrs:s' => 'JSON string to be used for the second argument for search'],
61    ['where:s' => 'JSON string to be used for the where clause of search'],
62    ['force' => 'Be forceful with some operations'],
63    ['trace' => 'Turn on DBIx::Class trace output'],
64    ['quiet' => 'Be less verbose'],
65  )
66);
67
68die "please only use one of --config or --connect-info\n" if ($opts->{config} and $opts->{connect_info});
69
70if($opts->{selfinject_pod}) {
71
72    die "This is an internal method, do not call!!!\n"
73      unless $ENV{MAKELEVEL};
74
75    $usage->synopsis($synopsis_text);
76    $usage->short_description($short_description);
77    exec (
78      $^X,
79      qw/-p -0777 -i -e/,
80      (
81        's/^# auto_pod_begin.*^# auto_pod_end/'
82      . quotemeta($usage->pod)
83      . '/ms'
84      ),
85      __FILE__
86    );
87}
88
89if($opts->{help}) {
90    $usage->die();
91}
92
93# option compatability mangle
94if($opts->{connect}) {
95  $opts->{connect_info} = delete $opts->{connect};
96}
97
98my $admin = DBIx::Class::Admin->new( %$opts );
99
100
101my $action = $opts->{action};
102
103$action = $opts->{op} if ($action eq 'op');
104
105print "Performig action $action...\n";
106
107my $res = $admin->$action();
108if ($action eq 'select') {
109
110  my $format = $opts->{format} || 'tsv';
111  die('Invalid format') if ($format!~/^tsv|csv$/s);
112
113  require Text::CSV;
114
115  my $csv = Text::CSV->new({
116    sep_char => ( $format eq 'tsv' ? "\t" : ',' ),
117  });
118
119  foreach my $row (@$res) {
120    $csv->combine( @$row );
121    print $csv->string()."\n";
122  }
123}
124
125
126__END__
127
128=head1 NAME
129
130dbicadmin - utility for administrating DBIx::Class schemata
131
132=head1 SYNOPSIS
133
134dbicadmin: [long options...]
135
136  deploy a schema to a database
137  dbicadmin --schema=MyApp::Schema \
138    --connect='["dbi:SQLite:my.db", "", ""]' \
139    --deploy
140
141  update an existing record
142  dbicadmin --schema=MyApp::Schema --class=Employee \
143    --connect='["dbi:SQLite:my.db", "", ""]' \
144    --op=update --set='{ "name": "New_Employee" }'
145
146
147
148=head1 OPTIONS
149
150=over
151
152=back
153
154=head2 Actions
155
156=cut
157
158=over
159
160=item B<--create>
161
162Create version diffs needs preversion
163
164=cut
165
166=item B<--upgrade>
167
168Upgrade the database to the current schema 
169
170=cut
171
172=item B<--install>
173
174Install the schema version tables to an existing database
175
176=cut
177
178=item B<--deploy>
179
180Deploy the schema to the database
181
182=cut
183
184=item B<--select>
185
186Select data from the schema
187
188=cut
189
190=item B<--insert>
191
192Insert data into the schema
193
194=cut
195
196=item B<--update>
197
198Update data in the schema
199
200=cut
201
202=item B<--delete>
203
204Delete data from the schema
205
206=cut
207
208=item B<--op>
209
210compatiblity option all of the above can be suppied as --op=<action>
211
212=cut
213
214=item B<--help>
215
216display this help
217
218=cut
219
220=item B<--selfinject-pod>
221
222hidden
223
224=cut
225
226=back
227
228=head2 Arguments
229
230=cut
231
232=over
233
234=item B<--schema-class>
235
236The class of the schema to load
237
238=cut
239
240=item B<--resultset> or B<--resultset-class> or B<--class>
241
242The resultset to operate on for data manipulation
243
244=cut
245
246=item B<--config-stanza>
247
248Where in the config to find the connection_info, supply in form MyApp::Model::DB
249
250=cut
251
252=item B<--config>
253
254Supply the config file for parsing by Config::Any
255
256=cut
257
258=item B<--connect-info>
259
260Supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> 
261
262=cut
263
264=item B<--connect>
265
266Supply the connect info as a json string
267
268=cut
269
270=item B<--sql-dir>
271
272The directory where sql diffs will be created
273
274=cut
275
276=item B<--sql-type>
277
278The RDBMs flavour you wish to use
279
280=cut
281
282=item B<--version>
283
284Supply a version install
285
286=cut
287
288=item B<--preversion>
289
290The previous version to diff against
291
292=cut
293
294=item B<--set>
295
296JSON data used to perform data operations
297
298=cut
299
300=item B<--attrs>
301
302JSON string to be used for the second argument for search
303
304=cut
305
306=item B<--where>
307
308JSON string to be used for the where clause of search
309
310=cut
311
312=item B<--force>
313
314Be forceful with some operations
315
316=cut
317
318=item B<--trace>
319
320Turn on DBIx::Class trace output
321
322=cut
323
324=item B<--quiet>
325
326Be less verbose
327
328=cut
329
330=back
331
332
333=head1 AUTHORS
334
335See L<DBIx::Class/CONTRIBUTORS>
336
337=head1 LICENSE
338
339You may distribute this code under the same terms as Perl itself
340
341=cut
342
343# vim: et ft=perl
344