Commit | Line | Data |
fd27648a |
1 | #!/usr/bin/perl |
2 | |
a94aa524 |
3 | use strict; |
4 | use warnings; |
5 | |
fd27648a |
6 | use Getopt::Long::Descriptive; |
7 | |
8 | use FindBin qw($Bin); |
9 | use Path::Class; |
10 | use lib dir($Bin,'..','lib')->stringify; |
11 | |
12 | use DBIx::Class::Admin; |
13 | |
14 | |
15 | my ($opts, $usage) = describe_options( |
16 | "%c: %o", |
17 | ( |
18 | ['Actions'], |
19 | ["action" => hidden => { one_of => [ |
20 | ['create|c' => 'Create version diffs needs preversion',], |
21 | ['upgrade|u' => 'Upgrade the database to the current schema '], |
22 | ['install|i' => 'Install the schema to the database',], |
c57f1cf7 |
23 | ['deploy|d' => 'Deploy the a to the database',], |
fd27648a |
24 | ['select|s' => 'Select data from the schema', ], |
25 | ['insert|i' => 'Insert data into the schema', ], |
26 | ['update|u' => 'Update data in the schema', ], |
27 | ['delete|D' => 'Delete data from the schema',], |
c57f1cf7 |
28 | ['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'], |
fd27648a |
29 | ['help|h' => 'display this help'], |
30 | ], required=> 1 }], |
31 | ['Options'], |
32 | ['schema-class|schema|C:s' => 'The class of the schema to load', { required => 1 } ], |
33 | ['resultset|resultset_class|class|r:s' => 'The resultset to operate on for data manipulation' ], |
34 | ['config-stanza|S:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',], |
35 | ['config|f:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ], |
36 | ['connect-info|n:s%' => 'Supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> '], |
37 | ['connect:s' => 'Supply the connect info as a json string' ], |
38 | ['sql-dir|q:s' => 'The directory where sql diffs will be created'], |
39 | ['sql-type|t:s' => 'The RDBMs flavour you wish to use'], |
40 | ['version|v:i' => 'Supply a version install'], |
41 | ['preversion|p:s' => 'The previous version to diff against',], |
42 | ['set:s' => 'JSON data used to perform data operations' ], |
43 | ['lib|I:s' => 'Additonal library path to search in'], |
44 | ['attrs:s' => 'JSON string to be used for the second argument for search'], |
45 | ['where:s' => 'JSON string to be used for the where clause of search'], |
46 | ['force' => 'Be forceful with some operations'], |
47 | ['trace' => 'Turn on DBIx::Class trace output'], |
48 | ['tlibs' => 'Include test dirs in @INC'], |
49 | ['quiet' => 'Be less verbose'], |
50 | ) |
2bbc85c9 |
51 | ); |
a94aa524 |
52 | |
d8d6276a |
53 | |
fd27648a |
54 | if ($opts->{help}) { |
55 | print $usage->text; |
56 | exit 0; |
b04e5d3e |
57 | } |
a94aa524 |
58 | |
fd27648a |
59 | if ($opts->{tlibs}) { |
60 | unshift( @INC, 't/lib', 'lib' ); |
61 | } |
a94aa524 |
62 | |
fd27648a |
63 | die "please only use one of --config or --connect-info" if ($opts->{config} and $opts->{connect_info}); |
a94aa524 |
64 | |
fd27648a |
65 | # option compatability mangle |
66 | if($opts->{connect}) { |
67 | $opts->{connect_info} = delete $opts->{connect}; |
b04e5d3e |
68 | } |
a94aa524 |
69 | |
fd27648a |
70 | my $admin = DBIx::Class::Admin->new( %$opts ); |
71 | |
72 | |
73 | my $action = $opts->{action}; |
c57f1cf7 |
74 | |
75 | $action = $opts->{op} if ($action eq 'op'); |
fd27648a |
76 | my $res = $admin->$action(); |
77 | |
c57f1cf7 |
78 | print "going to perform action $action\n"; |
fd27648a |
79 | if ($action eq 'select') { |
80 | |
81 | my $csv_class; |
82 | my $format = $opts->{format} || 'tsv'; |
83 | die('Invalid format') if ($format!~/^tsv|csv$/s); |
84 | $csv_class = 'Text::CSV_XS'; |
85 | eval{ require Text::CSV_XS }; |
86 | if ($@) { |
87 | $csv_class = 'Text::CSV_PP'; |
88 | eval{ require Text::CSV_PP }; |
89 | die('The select op requires either the Text::CSV_XS or the Text::CSV_PP module') if ($@); |
90 | } |
91 | |
92 | my $csv = $csv_class->new({ |
93 | sep_char => ( $format eq 'tsv' ? "\t" : ',' ), |
94 | }); |
95 | foreach my $row (@$res) { |
96 | $csv->combine( @$row ); |
97 | print $csv->string()."\n"; |
98 | } |
a94aa524 |
99 | } |
100 | |
d8d6276a |
101 | |
6717e3a8 |
102 | |
a94aa524 |
103 | =head1 AUTHOR |
104 | |
105 | Aran Deltac <bluefeet@cpan.org> |
106 | |
fd27648a |
107 | refactored by |
108 | Gordon Irving <goraxe@cpan.org> |
109 | |
a94aa524 |
110 | =head1 LICENSE |
111 | |
112 | You may distribute this code under the same terms as Perl itself. |