1 package DBIx::Class::Admin;
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";
14 use JSON::Any qw(DWIW PP JSON CPANEL XS);
16 use MooseX::Types::Moose qw/Int Str Any Bool/;
17 use DBIx::Class::Admin::Types qw/DBICConnectInfo DBICHashRef/;
18 use MooseX::Types::JSON qw(JSON);
19 use MooseX::Types::Path::Class qw(Dir File);
20 use MooseX::Types::LoadableClass qw(LoadableClass);
25 DBIx::Class::Admin - Administration object for schemas
31 $ dbicadmin --schema=MyApp::Schema \
32 --connect='["dbi:SQLite:my.db", "", ""]' \
35 $ dbicadmin --schema=MyApp::Schema --class=Employee \
36 --connect='["dbi:SQLite:my.db", "", ""]' \
37 --op=update --set='{ "name": "New_Employee" }'
39 use DBIx::Class::Admin;
42 my $admin = DBIx::Class::Admin->new(
43 schema_class=> 'MY::Schema',
45 connect_info => { dsn => $dsn, user => $user, password => $pass },
49 $admin->create('SQLite');
51 # create SQL diff for an upgrade
52 $admin->create('SQLite', {} , "1.0");
57 # install a version for an unversioned schema
58 $admin->install("3.0");
62 The Admin interface has additional requirements not currently part of
63 L<DBIx::Class>. See L<DBIx::Class::Optional::Dependencies> for more details.
69 the class of the schema to load
73 has 'schema_class' => (
81 A pre-connected schema object can be provided for manipulation
87 isa => 'DBIx::Class::Schema',
94 $self->connect_info->[3]{ignore_version} = 1;
95 return $self->schema_class->connect(@{$self->connect_info});
100 a resultset from the schema to operate on
112 a hash ref or json string to be used for identifying data to manipulate
125 a hash ref or json string to be used for inserting or updating data
138 a hash ref or json string to be used for passing additional info to the ->search call
151 connect_info the arguments to provide to the connect call of the schema_class
155 has 'connect_info' => (
157 isa => DBICConnectInfo,
162 sub _build_connect_info {
164 return $self->_find_stanza($self->config, $self->config_stanza);
170 config_file provide a config_file to read connect_info from, if this is provided
171 config_stanze should also be provided to locate where the connect_info is in the config
172 The config file should be in a format readable by Config::Any.
185 config_stanza for use with config_file should be a '::' delimited 'path' to the connection information
186 designed for use with catalyst config files
190 has 'config_stanza' => (
198 Instead of loading from a file the configuration can be provided directly as a hash ref. Please note
199 config_stanza will still be required.
212 my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1});
214 # just grab the config from the config file
215 $cfg = $cfg->{$self->config_file};
222 The location where sql ddl files should be created or found for an upgrade.
235 The type of sql dialect to use for creating sql files from schema
246 Used for install, the version which will be 'installed' in the schema
258 Previous 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
270 Try and force certain operations.
282 Be less verbose about actions
299 Toggle DBIx::Class debug output
306 trigger => \&_trigger_trace,
310 my ($self, $new, $old) = @_;
311 $self->schema->storage->debug($new);
321 =item Arguments: $sqlt_type, \%sqlt_args, $preversion
325 C<create> will generate sql for the supplied schema_class in sql_dir. The
326 flavour of sql to generate can be controlled by supplying a sqlt_type which
327 should be a L<SQL::Translator> name.
329 Arguments for L<SQL::Translator> can be supplied in the sqlt_args hashref.
331 Optional preversion can be supplied to generate a diff to be used by upgrade.
336 my ($self, $sqlt_type, $sqlt_args, $preversion) = @_;
338 $preversion ||= $self->preversion();
339 $sqlt_type ||= $self->sql_type();
341 my $schema = $self->schema();
343 $schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $preversion, $sqlt_args );
351 =item Arguments: <none>
355 upgrade will attempt to upgrade the connected database to the same version as the schema_class.
356 B<MAKE SURE YOU BACKUP YOUR DB FIRST>
362 my $schema = $self->schema();
364 if (!$schema->get_db_version()) {
365 # schema is unversioned
366 $schema->throw_exception ("Could not determin current schema version, please either install() or deploy().\n");
368 $schema->upgrade_directory ($self->sql_dir) if $self->sql_dir; # this will override whatever default the schema has
369 my $ret = $schema->upgrade();
379 =item Arguments: $version
383 install is here to help when you want to move to L<DBIx::Class::Schema::Versioned> and have an existing
384 database. install will take a version and add the version tracking tables and 'install' the version. No
385 further ddl modification takes place. Setting the force attribute to a true value will allow overriding of
386 already versioned databases.
391 my ($self, $version) = @_;
393 my $schema = $self->schema();
394 $version ||= $self->version();
395 if (!$schema->get_db_version() ) {
396 # schema is unversioned
397 print "Going to install schema version\n" if (!$self->quiet);
398 my $ret = $schema->install($version);
399 print "return is $ret\n" if (!$self->quiet);
401 elsif ($schema->get_db_version() and $self->force ) {
402 warn "Forcing install may not be a good idea\n";
403 if($self->_confirm() ) {
404 $self->schema->_set_db_version({ version => $version});
408 $schema->throw_exception ("Schema already has a version. Try upgrade instead.\n");
418 =item Arguments: $args
422 deploy will create the schema at the connected database. C<$args> are passed straight to
423 L<DBIx::Class::Schema/deploy>.
428 my ($self, $args) = @_;
429 my $schema = $self->schema();
430 $schema->deploy( $args, $self->sql_dir );
437 =item Arguments: $rs, $set
441 insert takes the name of a resultset from the schema_class and a hashref of data to insert
447 my ($self, $rs, $set) = @_;
449 $rs ||= $self->resultset();
450 $set ||= $self->set();
451 my $resultset = $self->schema->resultset($rs);
452 my $obj = $resultset->new_result($set)->insert;
453 print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$self->quiet);
461 =item Arguments: $rs, $set, $where
465 update takes the name of a resultset from the schema_class, a hashref of data to update and
466 a where hash used to form the search for the rows to update.
471 my ($self, $rs, $set, $where) = @_;
473 $rs ||= $self->resultset();
474 $where ||= $self->where();
475 $set ||= $self->set();
476 my $resultset = $self->schema->resultset($rs);
477 $resultset = $resultset->search( ($where||{}) );
479 my $count = $resultset->count();
480 print "This action will modify $count ".ref($resultset)." records.\n" if (!$self->quiet);
482 if ( $self->force || $self->_confirm() ) {
483 $resultset->update_all( $set );
492 =item Arguments: $rs, $where, $attrs
496 delete takes the name of a resultset from the schema_class, a where hashref and a attrs to pass to ->search.
497 The found data is deleted and cannot be recovered.
502 my ($self, $rs, $where, $attrs) = @_;
504 $rs ||= $self->resultset();
505 $where ||= $self->where();
506 $attrs ||= $self->attrs();
507 my $resultset = $self->schema->resultset($rs);
508 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
510 my $count = $resultset->count();
511 print "This action will delete $count ".ref($resultset)." records.\n" if (!$self->quiet);
513 if ( $self->force || $self->_confirm() ) {
514 $resultset->delete_all();
523 =item Arguments: $rs, $where, $attrs
527 select takes the name of a resultset from the schema_class, a where hashref and a attrs to pass to ->search.
528 The found data is returned in a array ref where the first row will be the columns list.
533 my ($self, $rs, $where, $attrs) = @_;
535 $rs ||= $self->resultset();
536 $where ||= $self->where();
537 $attrs ||= $self->attrs();
538 my $resultset = $self->schema->resultset($rs);
539 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
542 my @columns = $resultset->result_source->columns();
543 push @data, [@columns];#
545 while (my $row = $resultset->next()) {
547 foreach my $column (@columns) {
548 push( @fields, $row->get_column($column) );
550 push @data, [@fields];
559 # mainly here for testing
560 return 1 if ($self->meta->get_attribute('_confirm')->get_value($self));
562 print "Are you sure you want to do this? (type YES to confirm) \n";
563 my $response = <STDIN>;
565 return ($response=~/^YES/);
569 my ($self, $cfg, $stanza) = @_;
570 my @path = split /::/, $stanza;
571 while (my $path = shift @path) {
572 if (exists $cfg->{$path}) {
573 $cfg = $cfg->{$path};
576 die ("Could not find $stanza in config, $path does not seem to exist.\n");
579 $cfg = $cfg->{connect_info} if exists $cfg->{connect_info};
583 =head1 FURTHER QUESTIONS?
585 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
587 =head1 COPYRIGHT AND LICENSE
589 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
590 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
591 redistribute it and/or modify it under the same terms as the
592 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.