Remove dead code commented out since 2006 ( 953a18ef )
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Admin.pm
CommitLineData
9f3849c3 1package DBIx::Class::Admin;
2
c96bf2bc 3use warnings;
4use strict;
5
71ef99d5 6# check deps
7BEGIN {
c96bf2bc 8 require DBIx::Class::Optional::Dependencies;
9 if (my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('admin') ) {
10 die "The following extra modules are required for DBIx::Class::Admin: $missing\n";
11 }
71ef99d5 12}
585072bb 13
be855469 14use JSON::Any qw(DWIW PP JSON CPANEL XS);
71ef99d5 15use Moose;
a62dec82 16use MooseX::Types::Moose qw/Int Str Any Bool/;
17use DBIx::Class::Admin::Types qw/DBICConnectInfo DBICHashRef/;
71ef99d5 18use MooseX::Types::JSON qw(JSON);
19use MooseX::Types::Path::Class qw(Dir File);
d401ab6b 20use MooseX::Types::LoadableClass qw(LoadableClass);
71ef99d5 21use Try::Tiny;
77a6448d 22use namespace::clean;
bb464677 23
595cb2c7 24=head1 NAME
25
26DBIx::Class::Admin - Administration object for schemas
27
28=head1 SYNOPSIS
29
47442cea 30 $ dbicadmin --help
31
32 $ dbicadmin --schema=MyApp::Schema \
33 --connect='["dbi:SQLite:my.db", "", ""]' \
34 --deploy
35
36 $ dbicadmin --schema=MyApp::Schema --class=Employee \
37 --connect='["dbi:SQLite:my.db", "", ""]' \
cbde5b15 38 --op=update --set='{ "name": "New_Employee" }'
47442cea 39
9c34993a 40 use DBIx::Class::Admin;
595cb2c7 41
9c34993a 42 # ddl manipulation
43 my $admin = DBIx::Class::Admin->new(
44 schema_class=> 'MY::Schema',
45 sql_dir=> $sql_dir,
46 connect_info => { dsn => $dsn, user => $user, password => $pass },
47 );
595cb2c7 48
9c34993a 49 # create SQLite sql
50 $admin->create('SQLite');
595cb2c7 51
9c34993a 52 # create SQL diff for an upgrade
53 $admin->create('SQLite', {} , "1.0");
595cb2c7 54
9c34993a 55 # upgrade a database
56 $admin->upgrade();
595cb2c7 57
9c34993a 58 # install a version for an unversioned schema
59 $admin->install("3.0");
9f3849c3 60
47442cea 61=head1 REQUIREMENTS
62
a4a02f15 63The Admin interface has additional requirements not currently part of
64L<DBIx::Class>. See L<DBIx::Class::Optional::Dependencies> for more details.
47442cea 65
a4a02f15 66=head1 ATTRIBUTES
9f3849c3 67
595cb2c7 68=head2 schema_class
9f3849c3 69
595cb2c7 70the class of the schema to load
e81f0fe2 71
595cb2c7 72=cut
e81f0fe2 73
9f3849c3 74has 'schema_class' => (
3b27cdac 75 is => 'ro',
d401ab6b 76 isa => LoadableClass,
9f3849c3 77);
78
e81f0fe2 79
595cb2c7 80=head2 schema
9f3849c3 81
595cb2c7 82A pre-connected schema object can be provided for manipulation
e81f0fe2 83
595cb2c7 84=cut
e81f0fe2 85
9f3849c3 86has 'schema' => (
3b27cdac 87 is => 'ro',
88 isa => 'DBIx::Class::Schema',
a705b175 89 lazy_build => 1,
9f3849c3 90);
91
9f3849c3 92sub _build_schema {
a705b175 93 my ($self) = @_;
312eef08 94
8c96bbc2 95 $self->connect_info->[3]{ignore_version} = 1;
96 return $self->schema_class->connect(@{$self->connect_info});
9f3849c3 97}
98
bb464677 99=head2 resultset
100
101a resultset from the schema to operate on
e81f0fe2 102
bb464677 103=cut
e81f0fe2 104
bb464677 105has 'resultset' => (
3b27cdac 106 is => 'rw',
107 isa => Str,
bb464677 108);
109
e81f0fe2 110
bb464677 111=head2 where
112
113a hash ref or json string to be used for identifying data to manipulate
e81f0fe2 114
bb464677 115=cut
116
117has 'where' => (
a705b175 118 is => 'rw',
3b27cdac 119 isa => DBICHashRef,
120 coerce => 1,
bb464677 121);
122
e81f0fe2 123
bb464677 124=head2 set
e81f0fe2 125
bb464677 126a hash ref or json string to be used for inserting or updating data
e81f0fe2 127
bb464677 128=cut
129
130has 'set' => (
a705b175 131 is => 'rw',
3b27cdac 132 isa => DBICHashRef,
133 coerce => 1,
bb464677 134);
135
e81f0fe2 136
bb464677 137=head2 attrs
e81f0fe2 138
4d1e63f4 139a hash ref or json string to be used for passing additional info to the ->search call
e81f0fe2 140
bb464677 141=cut
e81f0fe2 142
bb464677 143has 'attrs' => (
3b27cdac 144 is => 'rw',
145 isa => DBICHashRef,
146 coerce => 1,
bb464677 147);
e81f0fe2 148
149
595cb2c7 150=head2 connect_info
151
152connect_info the arguments to provide to the connect call of the schema_class
bb464677 153
e81f0fe2 154=cut
bb464677 155
9f3849c3 156has 'connect_info' => (
3b27cdac 157 is => 'ro',
158 isa => DBICConnectInfo,
a705b175 159 lazy_build => 1,
3b27cdac 160 coerce => 1,
9f3849c3 161);
162
163sub _build_connect_info {
a705b175 164 my ($self) = @_;
165 return $self->_find_stanza($self->config, $self->config_stanza);
9f3849c3 166}
167
e81f0fe2 168
595cb2c7 169=head2 config_file
170
171config_file provide a config_file to read connect_info from, if this is provided
172config_stanze should also be provided to locate where the connect_info is in the config
7b71391b 173The config file should be in a format readable by Config::Any.
e81f0fe2 174
595cb2c7 175=cut
e81f0fe2 176
595cb2c7 177has config_file => (
a705b175 178 is => 'ro',
3b27cdac 179 isa => File,
180 coerce => 1,
595cb2c7 181);
182
e81f0fe2 183
595cb2c7 184=head2 config_stanza
185
4d1e63f4 186config_stanza for use with config_file should be a '::' delimited 'path' to the connection information
595cb2c7 187designed for use with catalyst config files
e81f0fe2 188
595cb2c7 189=cut
e81f0fe2 190
595cb2c7 191has 'config_stanza' => (
3b27cdac 192 is => 'ro',
193 isa => Str,
595cb2c7 194);
195
e81f0fe2 196
595cb2c7 197=head2 config
198
a03b396b 199Instead of loading from a file the configuration can be provided directly as a hash ref. Please note
595cb2c7 200config_stanza will still be required.
e81f0fe2 201
595cb2c7 202=cut
e81f0fe2 203
9f3849c3 204has config => (
3b27cdac 205 is => 'ro',
206 isa => DBICHashRef,
a705b175 207 lazy_build => 1,
9f3849c3 208);
209
210sub _build_config {
a705b175 211 my ($self) = @_;
71766122 212
9780718f 213 try { require Config::Any }
214 catch { die ("Config::Any is required to parse the config file.\n") };
9f3849c3 215
a705b175 216 my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1});
9f3849c3 217
a705b175 218 # just grab the config from the config file
219 $cfg = $cfg->{$self->config_file};
220 return $cfg;
9f3849c3 221}
222
e81f0fe2 223
595cb2c7 224=head2 sql_dir
9f3849c3 225
595cb2c7 226The location where sql ddl files should be created or found for an upgrade.
e81f0fe2 227
595cb2c7 228=cut
e81f0fe2 229
9f3849c3 230has 'sql_dir' => (
a705b175 231 is => 'ro',
3b27cdac 232 isa => Dir,
233 coerce => 1,
9f3849c3 234);
235
e81f0fe2 236
f3386204 237=head2 sql_type
238
239The type of sql dialect to use for creating sql files from schema
240
241=cut
242
243has 'sql_type' => (
244 is => 'ro',
245 isa => Str,
246);
247
595cb2c7 248=head2 version
9f3849c3 249
595cb2c7 250Used for install, the version which will be 'installed' in the schema
e81f0fe2 251
595cb2c7 252=cut
e81f0fe2 253
9f3849c3 254has version => (
3b27cdac 255 is => 'rw',
256 isa => Str,
9f3849c3 257);
258
e81f0fe2 259
595cb2c7 260=head2 preversion
261
4d1e63f4 262Previous version of the schema to create an upgrade diff for, the full sql for that version of the sql must be in the sql_dir
e81f0fe2 263
595cb2c7 264=cut
e81f0fe2 265
9f3849c3 266has preversion => (
3b27cdac 267 is => 'rw',
268 isa => Str,
9f3849c3 269);
270
e81f0fe2 271
595cb2c7 272=head2 force
273
274Try and force certain operations.
e81f0fe2 275
595cb2c7 276=cut
e81f0fe2 277
912e2d5a 278has force => (
3b27cdac 279 is => 'rw',
280 isa => Bool,
912e2d5a 281);
282
e81f0fe2 283
c57f1cf7 284=head2 quiet
595cb2c7 285
286Be less verbose about actions
e81f0fe2 287
595cb2c7 288=cut
e81f0fe2 289
64c012f4 290has quiet => (
3b27cdac 291 is => 'rw',
292 isa => Bool,
64c012f4 293);
294
912e2d5a 295has '_confirm' => (
3b27cdac 296 is => 'bare',
297 isa => Bool,
912e2d5a 298);
299
e81f0fe2 300
f3386204 301=head2 trace
302
303Toggle DBIx::Class debug output
304
305=cut
306
307has trace => (
308 is => 'rw',
309 isa => Bool,
310 trigger => \&_trigger_trace,
311);
312
313sub _trigger_trace {
314 my ($self, $new, $old) = @_;
315 $self->schema->storage->debug($new);
316}
317
318
595cb2c7 319=head1 METHODS
320
321=head2 create
322
323=over 4
324
325=item Arguments: $sqlt_type, \%sqlt_args, $preversion
326
327=back
328
f92a9d79 329C<create> will generate sql for the supplied schema_class in sql_dir. The
8f987bd5 330flavour of sql to generate can be controlled by supplying a sqlt_type which
331should be a L<SQL::Translator> name.
595cb2c7 332
333Arguments for L<SQL::Translator> can be supplied in the sqlt_args hashref.
334
335Optional preversion can be supplied to generate a diff to be used by upgrade.
e81f0fe2 336
595cb2c7 337=cut
338
9f3849c3 339sub create {
a705b175 340 my ($self, $sqlt_type, $sqlt_args, $preversion) = @_;
595cb2c7 341
a705b175 342 $preversion ||= $self->preversion();
f3386204 343 $sqlt_type ||= $self->sql_type();
595cb2c7 344
a705b175 345 my $schema = $self->schema();
9f3849c3 346
a705b175 347 $schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $preversion, $sqlt_args );
9f3849c3 348}
349
e81f0fe2 350
595cb2c7 351=head2 upgrade
352
353=over 4
354
355=item Arguments: <none>
356
357=back
358
359upgrade will attempt to upgrade the connected database to the same version as the schema_class.
360B<MAKE SURE YOU BACKUP YOUR DB FIRST>
e81f0fe2 361
595cb2c7 362=cut
363
9f3849c3 364sub upgrade {
a705b175 365 my ($self) = @_;
366 my $schema = $self->schema();
15de9f06 367
a705b175 368 if (!$schema->get_db_version()) {
369 # schema is unversioned
b718fd0a 370 $schema->throw_exception ("Could not determin current schema version, please either install() or deploy().\n");
a705b175 371 } else {
23737393 372 $schema->upgrade_directory ($self->sql_dir) if $self->sql_dir; # this will override whatever default the schema has
a705b175 373 my $ret = $schema->upgrade();
374 return $ret;
375 }
9f3849c3 376}
377
e81f0fe2 378
595cb2c7 379=head2 install
380
381=over 4
382
383=item Arguments: $version
384
385=back
386
a03b396b 387install is here to help when you want to move to L<DBIx::Class::Schema::Versioned> and have an existing
388database. install will take a version and add the version tracking tables and 'install' the version. No
389further ddl modification takes place. Setting the force attribute to a true value will allow overriding of
595cb2c7 390already versioned databases.
e81f0fe2 391
595cb2c7 392=cut
e81f0fe2 393
9f3849c3 394sub install {
a705b175 395 my ($self, $version) = @_;
396
397 my $schema = $self->schema();
398 $version ||= $self->version();
399 if (!$schema->get_db_version() ) {
400 # schema is unversioned
15de9f06 401 print "Going to install schema version\n" if (!$self->quiet);
a705b175 402 my $ret = $schema->install($version);
15de9f06 403 print "return is $ret\n" if (!$self->quiet);
a705b175 404 }
405 elsif ($schema->get_db_version() and $self->force ) {
70c28808 406 warn "Forcing install may not be a good idea\n";
a705b175 407 if($self->_confirm() ) {
a705b175 408 $self->schema->_set_db_version({ version => $version});
9c34993a 409 }
a705b175 410 }
411 else {
b718fd0a 412 $schema->throw_exception ("Schema already has a version. Try upgrade instead.\n");
a705b175 413 }
9f3849c3 414
415}
416
e81f0fe2 417
595cb2c7 418=head2 deploy
419
420=over 4
421
422=item Arguments: $args
423
424=back
425
a03b396b 426deploy will create the schema at the connected database. C<$args> are passed straight to
e81f0fe2 427L<DBIx::Class::Schema/deploy>.
428
595cb2c7 429=cut
e81f0fe2 430
9f3849c3 431sub deploy {
a705b175 432 my ($self, $args) = @_;
433 my $schema = $self->schema();
a03b396b 434 $schema->deploy( $args, $self->sql_dir );
9f3849c3 435}
436
bb464677 437=head2 insert
595cb2c7 438
439=over 4
440
441=item Arguments: $rs, $set
442
443=back
444
bb464677 445insert takes the name of a resultset from the schema_class and a hashref of data to insert
595cb2c7 446into that resultset
447
448=cut
e81f0fe2 449
bb464677 450sub insert {
a705b175 451 my ($self, $rs, $set) = @_;
bb464677 452
a705b175 453 $rs ||= $self->resultset();
454 $set ||= $self->set();
455 my $resultset = $self->schema->resultset($rs);
77c3a5dc 456 my $obj = $resultset->new_result($set)->insert;
a705b175 457 print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$self->quiet);
9f3849c3 458}
459
595cb2c7 460
bb464677 461=head2 update
595cb2c7 462
e81f0fe2 463=over 4
595cb2c7 464
465=item Arguments: $rs, $set, $where
466
467=back
468
e81f0fe2 469update takes the name of a resultset from the schema_class, a hashref of data to update and
470a where hash used to form the search for the rows to update.
471
595cb2c7 472=cut
e81f0fe2 473
bb464677 474sub update {
a705b175 475 my ($self, $rs, $set, $where) = @_;
882931aa 476
a705b175 477 $rs ||= $self->resultset();
478 $where ||= $self->where();
479 $set ||= $self->set();
480 my $resultset = $self->schema->resultset($rs);
481 $resultset = $resultset->search( ($where||{}) );
882931aa 482
a705b175 483 my $count = $resultset->count();
484 print "This action will modify $count ".ref($resultset)." records.\n" if (!$self->quiet);
882931aa 485
a705b175 486 if ( $self->force || $self->_confirm() ) {
487 $resultset->update_all( $set );
488 }
9f3849c3 489}
490
e81f0fe2 491
bb464677 492=head2 delete
595cb2c7 493
494=over 4
495
496=item Arguments: $rs, $where, $attrs
497
498=back
499
e81f0fe2 500delete takes the name of a resultset from the schema_class, a where hashref and a attrs to pass to ->search.
595cb2c7 501The found data is deleted and cannot be recovered.
e81f0fe2 502
595cb2c7 503=cut
e81f0fe2 504
bb464677 505sub delete {
a705b175 506 my ($self, $rs, $where, $attrs) = @_;
9f3849c3 507
a705b175 508 $rs ||= $self->resultset();
509 $where ||= $self->where();
510 $attrs ||= $self->attrs();
511 my $resultset = $self->schema->resultset($rs);
512 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
9f3849c3 513
a705b175 514 my $count = $resultset->count();
515 print "This action will delete $count ".ref($resultset)." records.\n" if (!$self->quiet);
9f3849c3 516
a705b175 517 if ( $self->force || $self->_confirm() ) {
518 $resultset->delete_all();
519 }
9f3849c3 520}
521
e81f0fe2 522
bb464677 523=head2 select
595cb2c7 524
525=over 4
526
527=item Arguments: $rs, $where, $attrs
528
529=back
530
a03b396b 531select takes the name of a resultset from the schema_class, a where hashref and a attrs to pass to ->search.
595cb2c7 532The found data is returned in a array ref where the first row will be the columns list.
533
534=cut
e81f0fe2 535
bb464677 536sub select {
a705b175 537 my ($self, $rs, $where, $attrs) = @_;
538
539 $rs ||= $self->resultset();
540 $where ||= $self->where();
541 $attrs ||= $self->attrs();
542 my $resultset = $self->schema->resultset($rs);
543 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
544
545 my @data;
546 my @columns = $resultset->result_source->columns();
a03b396b 547 push @data, [@columns];#
a705b175 548
549 while (my $row = $resultset->next()) {
550 my @fields;
551 foreach my $column (@columns) {
552 push( @fields, $row->get_column($column) );
9c34993a 553 }
a705b175 554 push @data, [@fields];
555 }
9c34993a 556
a705b175 557 return \@data;
9f3849c3 558}
559
595cb2c7 560sub _confirm {
a705b175 561 my ($self) = @_;
15de9f06 562
a705b175 563 # mainly here for testing
564 return 1 if ($self->meta->get_attribute('_confirm')->get_value($self));
15de9f06 565
566 print "Are you sure you want to do this? (type YES to confirm) \n";
a705b175 567 my $response = <STDIN>;
15de9f06 568
569 return ($response=~/^YES/);
9f3849c3 570}
571
595cb2c7 572sub _find_stanza {
a705b175 573 my ($self, $cfg, $stanza) = @_;
574 my @path = split /::/, $stanza;
575 while (my $path = shift @path) {
576 if (exists $cfg->{$path}) {
577 $cfg = $cfg->{$path};
578 }
579 else {
b718fd0a 580 die ("Could not find $stanza in config, $path does not seem to exist.\n");
9c34993a 581 }
a705b175 582 }
7b71391b 583 $cfg = $cfg->{connect_info} if exists $cfg->{connect_info};
a705b175 584 return $cfg;
595cb2c7 585}
bb464677 586
a2bd3796 587=head1 FURTHER QUESTIONS?
bb464677 588
a2bd3796 589Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
bb464677 590
a2bd3796 591=head1 COPYRIGHT AND LICENSE
bb464677 592
a2bd3796 593This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
594by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
595redistribute it and/or modify it under the same terms as the
596L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
e81f0fe2 597
bb464677 598=cut
e81f0fe2 599
9f3849c3 6001;