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