Commit | Line | Data |
9274250d |
1 | #!/usr/bin/perl |
a705b175 |
2 | |
a94aa524 |
3 | use strict; |
4 | use warnings; |
5 | |
a4a02f15 |
6 | BEGIN { |
7 | use DBIx::Class; |
8 | die ( "The following modules are required for the dbicadmin utility\n" |
9 | . DBIx::Class::Optional::Dependencies->req_missing_for ('admin_script') |
10 | ) unless DBIx::Class::Optional::Dependencies->req_ok_for ('admin_script'); |
11 | } |
12 | |
e5279977 |
13 | use DBIx::Class::Admin::Descriptive; |
14 | #use Getopt::Long::Descriptive; |
fd27648a |
15 | use DBIx::Class::Admin; |
16 | |
e5279977 |
17 | my $short_description = "utility for administrating DBIx::Class schemata"; |
18 | my $synopsis_text =qq{ |
19 | deploy a schema to a database |
20 | %c --schema=MyApp::Schema \ |
21 | --connect='["dbi:SQLite:my.db", "", ""]' \ |
22 | --deploy |
23 | |
24 | update an existing record |
25 | %c --schema=MyApp::Schema --class=Employee \ |
26 | --connect='["dbi:SQLite:my.db", "", ""]' \ |
27 | --op=update --set='{ "name": "New_Employee" }' |
28 | } |
29 | ; |
30 | |
fd27648a |
31 | my ($opts, $usage) = describe_options( |
e5279977 |
32 | "%c: %o", |
a705b175 |
33 | ( |
34 | ['Actions'], |
35 | ["action" => hidden => { one_of => [ |
36 | ['create|c' => 'Create version diffs needs preversion',], |
e5279977 |
37 | ['upgrade|U' => 'Upgrade the database to the current schema '], |
38 | ['install|I' => 'Install the schema version tables to an existing database',], |
71ef99d5 |
39 | ['deploy|d' => 'Deploy the schema to the database',], |
a705b175 |
40 | ['select|s' => 'Select data from the schema', ], |
41 | ['insert|i' => 'Insert data into the schema', ], |
42 | ['update|u' => 'Update data in the schema', ], |
43 | ['delete|D' => 'Delete data from the schema',], |
44 | ['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'], |
e5279977 |
45 | ['help|h' => 'display this help', { implies => { schema_class => 'main' } } ], |
46 | ['pod' => 'Output this usage as pod', { implies => { schema_class => 'main' } } ], |
a705b175 |
47 | ], required=> 1 }], |
d26b9726 |
48 | ['Arguments'], |
a705b175 |
49 | ['schema-class|schema|C:s' => 'The class of the schema to load', { required => 1 } ], |
50 | ['resultset|resultset_class|class|r:s' => 'The resultset to operate on for data manipulation' ], |
51 | ['config-stanza|S:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',], |
52 | ['config|f:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ], |
53 | ['connect-info|n: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|q:s' => 'The directory where sql diffs will be created'], |
56 | ['sql-type|t:s' => 'The RDBMs flavour you wish to use'], |
57 | ['version|v:i' => 'Supply a version install'], |
58 | ['preversion|p:s' => 'The previous version to diff against',], |
59 | ['set:s' => 'JSON data used to perform data operations' ], |
a705b175 |
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'], |
a705b175 |
64 | ['quiet' => 'Be less verbose'], |
65 | ) |
2bbc85c9 |
66 | ); |
a94aa524 |
67 | |
ad81fe7d |
68 | die "please only use one of --config or --connect-info\n" if ($opts->{config} and $opts->{connect_info}); |
a94aa524 |
69 | |
e5279977 |
70 | if($opts->{pod}) { |
71 | $usage->synopsis($synopsis_text); |
72 | $usage->short_description($short_description); |
73 | print $usage->pod(); |
74 | exit 0; |
75 | } |
76 | |
77 | if($opts->{help}) { |
78 | $usage->die(); |
79 | } |
80 | |
fd27648a |
81 | # option compatability mangle |
82 | if($opts->{connect}) { |
a705b175 |
83 | $opts->{connect_info} = delete $opts->{connect}; |
b04e5d3e |
84 | } |
a94aa524 |
85 | |
fd27648a |
86 | my $admin = DBIx::Class::Admin->new( %$opts ); |
87 | |
88 | |
89 | my $action = $opts->{action}; |
c57f1cf7 |
90 | |
91 | $action = $opts->{op} if ($action eq 'op'); |
fd27648a |
92 | |
ad81fe7d |
93 | print "Performig action $action...\n"; |
94 | |
95 | my $res = $admin->$action(); |
fd27648a |
96 | if ($action eq 'select') { |
97 | |
a705b175 |
98 | my $format = $opts->{format} || 'tsv'; |
99 | die('Invalid format') if ($format!~/^tsv|csv$/s); |
a705b175 |
100 | |
ad81fe7d |
101 | require Text::CSV; |
102 | |
103 | my $csv = Text::CSV->new({ |
104 | sep_char => ( $format eq 'tsv' ? "\t" : ',' ), |
105 | }); |
106 | |
a705b175 |
107 | foreach my $row (@$res) { |
108 | $csv->combine( @$row ); |
109 | print $csv->string()."\n"; |
110 | } |
a94aa524 |
111 | } |
e5279977 |
112 | __END__ |
113 | |
114 | =begin pod_begin |
115 | |
116 | BEGIN MARKER FOR DYNAMIC POD |
117 | |
118 | =end pod_begin |
119 | |
120 | =begin pod_end |
121 | |
122 | END MARKER FOR DYNAMIC POD |
123 | |
124 | =end pod_end |
a94aa524 |
125 | |
a94aa524 |
126 | =head1 AUTHOR |
127 | |
a4a02f15 |
128 | See L<DBIx::Class/CONTRIBUTORS>. |
fd27648a |
129 | |
a94aa524 |
130 | =head1 LICENSE |
131 | |
a4a02f15 |
132 | You may distribute this code under the same terms as Perl itself |
133 | |
134 | =cut |
e5279977 |
135 | |
136 | # vim: et ft=perl |