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