Commit | Line | Data |
f54428ab |
1 | #!/usr/bin/env perl |
a705b175 |
2 | |
a94aa524 |
3 | use strict; |
4 | use warnings; |
5 | |
a4a02f15 |
6 | BEGIN { |
7 | use DBIx::Class; |
3abee566 |
8 | die ( 'The following modules are required for the dbicadmin utility: ' |
a4a02f15 |
9 | . DBIx::Class::Optional::Dependencies->req_missing_for ('admin_script') |
3abee566 |
10 | . "\n" |
a4a02f15 |
11 | ) unless DBIx::Class::Optional::Dependencies->req_ok_for ('admin_script'); |
12 | } |
13 | |
e5279977 |
14 | use DBIx::Class::Admin::Descriptive; |
15 | #use Getopt::Long::Descriptive; |
fd27648a |
16 | use DBIx::Class::Admin; |
17 | |
e5279977 |
18 | my $short_description = "utility for administrating DBIx::Class schemata"; |
82b08554 |
19 | my $synopsis_text =q| |
e5279977 |
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" }' |
82b08554 |
29 | |; |
e5279977 |
30 | |
fd27648a |
31 | my ($opts, $usage) = describe_options( |
e5279977 |
32 | "%c: %o", |
a705b175 |
33 | ( |
34 | ['Actions'], |
35 | ["action" => hidden => { one_of => [ |
50936381 |
36 | ['create' => 'Create version diffs needs preversion'], |
7e1ca6dd |
37 | ['upgrade' => 'Upgrade the database to the current schema'], |
50936381 |
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'], |
4a0eed52 |
44 | ['op:s' => 'compatibility option all of the above can be supplied as --op=<action>'], |
19a59b9e |
45 | ['help' => 'display this help', { implies => { schema_class => '__dummy__' } } ], |
e2633789 |
46 | ['documentation-as-pod:s' => 'hidden', { implies => { schema_class => '__dummy__' } } ], |
7b71391b |
47 | ], required => 1 }], |
d26b9726 |
48 | ['Arguments'], |
7b71391b |
49 | ["configuration" => hidden => { one_of => [ |
50 | ['config-file|config:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ], |
51 | ['connect-info:s%' => 'Supply the connect info as trailing options e.g. --connect-info dsn=<dsn> user=<user> password=<pass>' ], |
52 | ['connect:s' => 'Supply the connect info as a JSON-encoded structure, e.g. an --connect=["dsn","user","pass"]'], |
50936381 |
53 | ] }], |
19a59b9e |
54 | ['schema-class:s' => 'The class of the schema to load', { required => 1 } ], |
19a59b9e |
55 | ['config-stanza:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',], |
7b71391b |
56 | ['resultset|resultset-class|class:s' => 'The resultset to operate on for data manipulation' ], |
19a59b9e |
57 | ['sql-dir:s' => 'The directory where sql diffs will be created'], |
58 | ['sql-type:s' => 'The RDBMs flavour you wish to use'], |
59 | ['version:i' => 'Supply a version install'], |
60 | ['preversion:s' => 'The previous version to diff against',], |
a705b175 |
61 | ['set:s' => 'JSON data used to perform data operations' ], |
a705b175 |
62 | ['attrs:s' => 'JSON string to be used for the second argument for search'], |
63 | ['where:s' => 'JSON string to be used for the where clause of search'], |
64 | ['force' => 'Be forceful with some operations'], |
65 | ['trace' => 'Turn on DBIx::Class trace output'], |
a705b175 |
66 | ['quiet' => 'Be less verbose'], |
099f10d1 |
67 | ['I:s@' => 'Same as perl\'s -I, prepended to current @INC'], |
a705b175 |
68 | ) |
2bbc85c9 |
69 | ); |
a94aa524 |
70 | |
e2633789 |
71 | if(defined (my $fn = $opts->{documentation_as_pod}) ) { |
72 | $usage->synopsis($synopsis_text); |
73 | $usage->short_description($short_description); |
74 | |
75 | if ($fn) { |
76 | require File::Spec; |
77 | require File::Path; |
78 | my $dir = File::Spec->catpath( (File::Spec->splitpath($fn))[0,1] ); |
79 | File::Path::mkpath([$dir]); |
80 | } |
81 | |
82 | local *STDOUT if $fn; |
83 | open (STDOUT, '>', $fn) or die "Unable to open $fn: $!\n" if $fn; |
84 | |
85 | print STDOUT "\n"; |
86 | print STDOUT $usage->pod; |
87 | print STDOUT "\n"; |
88 | |
89 | close STDOUT if $fn; |
90 | exit 0; |
e5279977 |
91 | } |
92 | |
6875b150 |
93 | # FIXME - lowercasing will eventually go away when Getopt::Long::Descriptive is fixed |
4e2873b1 |
94 | if($opts->{i}) { |
1c4391f3 |
95 | require lib; |
96 | lib->import( @{delete $opts->{i}} ); |
b13aab4f |
97 | } |
98 | |
e5279977 |
99 | if($opts->{help}) { |
1c4391f3 |
100 | $usage->die(); |
e5279977 |
101 | } |
102 | |
4a0eed52 |
103 | # option compatibility mangle |
7b71391b |
104 | # (can not be joined in the spec, one is s% the other is s) |
fd27648a |
105 | if($opts->{connect}) { |
a705b175 |
106 | $opts->{connect_info} = delete $opts->{connect}; |
b04e5d3e |
107 | } |
7b71391b |
108 | |
fd27648a |
109 | my $admin = DBIx::Class::Admin->new( %$opts ); |
110 | |
fd27648a |
111 | my $action = $opts->{action}; |
c57f1cf7 |
112 | |
113 | $action = $opts->{op} if ($action eq 'op'); |
fd27648a |
114 | |
b13aab4f |
115 | print "Performing action $action...\n"; |
ad81fe7d |
116 | |
117 | my $res = $admin->$action(); |
fd27648a |
118 | if ($action eq 'select') { |
119 | |
a705b175 |
120 | my $format = $opts->{format} || 'tsv'; |
121 | die('Invalid format') if ($format!~/^tsv|csv$/s); |
a705b175 |
122 | |
ad81fe7d |
123 | require Text::CSV; |
124 | |
125 | my $csv = Text::CSV->new({ |
126 | sep_char => ( $format eq 'tsv' ? "\t" : ',' ), |
127 | }); |
128 | |
a705b175 |
129 | foreach my $row (@$res) { |
130 | $csv->combine( @$row ); |
131 | print $csv->string()."\n"; |
132 | } |
a94aa524 |
133 | } |
e5279977 |
134 | |
e2633789 |
135 | 1; |
e5279977 |
136 | |
7d6f6a6e |
137 | __END__ |