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 Type::Utils qw(class_type);
17 use Types::Standard qw(Int Str Any Bool);
18 use DBIx::Class::Admin::Types qw(Dir File DBICConnectInfo DBICHashRef);
19 use 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 => class_type('DBIx::Class::Schema'),
97 $self->connect_info->[3]{ignore_version} = 1;
98 return $self->schema_class->connect(@{$self->connect_info});
103 a resultset from the schema to operate on
115 a hash ref or json string to be used for identifying data to manipulate
128 a hash ref or json string to be used for inserting or updating data
141 a hash ref or json string to be used for passing additional info to the ->search call
154 connect_info the arguments to provide to the connect call of the schema_class
158 has 'connect_info' => (
160 isa => DBICConnectInfo,
168 sub _build_connect_info {
170 return $self->_find_stanza($self->config, $self->config_stanza);
176 config_file provide a config_file to read connect_info from, if this is provided
177 config_stanze should also be provided to locate where the connect_info is in the config
178 The config file should be in a format readable by Config::Any.
191 config_stanza for use with config_file should be a '::' delimited 'path' to the connection information
192 designed for use with catalyst config files
196 has 'config_stanza' => (
204 Instead of loading from a file the configuration can be provided directly as a hash ref. Please note
205 config_stanza will still be required.
221 try { require Config::Any }
222 catch { die ("Config::Any is required to parse the config file.\n") };
224 my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1});
226 # just grab the config from the config file
227 $cfg = $cfg->{$self->config_file};
234 The location where sql ddl files should be created or found for an upgrade.
247 The type of sql dialect to use for creating sql files from schema
258 Used for install, the version which will be 'installed' in the schema
270 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
282 Try and force certain operations.
294 Be less verbose about actions
305 Toggle DBIx::Class debug output
312 trigger => \&_trigger_trace,
316 my ($self, $new, $old) = @_;
317 $self->schema->storage->debug($new);
327 =item Arguments: $sqlt_type, \%sqlt_args, $preversion
331 C<create> will generate sql for the supplied schema_class in sql_dir. The
332 flavour of sql to generate can be controlled by supplying a sqlt_type which
333 should be a L<SQL::Translator> name.
335 Arguments for L<SQL::Translator> can be supplied in the sqlt_args hashref.
337 Optional preversion can be supplied to generate a diff to be used by upgrade.
342 my ($self, $sqlt_type, $sqlt_args, $preversion) = @_;
344 $preversion ||= $self->preversion();
345 $sqlt_type ||= $self->sql_type();
347 my $schema = $self->schema();
348 # create the dir if does not exist
349 $self->sql_dir->mkpath() if ( ! -d $self->sql_dir);
351 $schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $preversion, $sqlt_args );
359 =item Arguments: <none>
363 upgrade will attempt to upgrade the connected database to the same version as the schema_class.
364 B<MAKE SURE YOU BACKUP YOUR DB FIRST>
370 my $schema = $self->schema();
372 if (!$schema->get_db_version()) {
373 # schema is unversioned
374 $schema->throw_exception ("Could not determin current schema version, please either install() or deploy().\n");
376 $schema->upgrade_directory ($self->sql_dir) if $self->sql_dir; # this will override whatever default the schema has
377 my $ret = $schema->upgrade();
387 =item Arguments: $version
391 install is here to help when you want to move to L<DBIx::Class::Schema::Versioned> and have an existing
392 database. install will take a version and add the version tracking tables and 'install' the version. No
393 further ddl modification takes place. Setting the force attribute to a true value will allow overriding of
394 already versioned databases.
399 my ($self, $version) = @_;
401 my $schema = $self->schema();
402 $version ||= $self->version();
403 if (!$schema->get_db_version() ) {
404 # schema is unversioned
405 print "Going to install schema version\n" if (!$self->quiet);
406 my $ret = $schema->install($version);
407 print "return is $ret\n" if (!$self->quiet);
409 elsif ($schema->get_db_version() and $self->force ) {
410 warn "Forcing install may not be a good idea\n";
411 if($self->_confirm() ) {
412 $self->schema->_set_db_version({ version => $version});
416 $schema->throw_exception ("Schema already has a version. Try upgrade instead.\n");
426 =item Arguments: $args
430 deploy will create the schema at the connected database. C<$args> are passed straight to
431 L<DBIx::Class::Schema/deploy>.
436 my ($self, $args) = @_;
437 my $schema = $self->schema();
438 $schema->deploy( $args, $self->sql_dir );
445 =item Arguments: $rs, $set
449 insert takes the name of a resultset from the schema_class and a hashref of data to insert
455 my ($self, $rs, $set) = @_;
457 $rs ||= $self->resultset();
458 $set ||= $self->set();
459 my $resultset = $self->schema->resultset($rs);
460 my $obj = $resultset->new_result($set)->insert;
461 print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$self->quiet);
469 =item Arguments: $rs, $set, $where
473 update takes the name of a resultset from the schema_class, a hashref of data to update and
474 a where hash used to form the search for the rows to update.
479 my ($self, $rs, $set, $where) = @_;
481 $rs ||= $self->resultset();
482 $where ||= $self->where();
483 $set ||= $self->set();
484 my $resultset = $self->schema->resultset($rs);
485 $resultset = $resultset->search( ($where||{}) );
487 my $count = $resultset->count();
488 print "This action will modify $count ".ref($resultset)." records.\n" if (!$self->quiet);
490 if ( $self->force || $self->_confirm() ) {
491 $resultset->update_all( $set );
500 =item Arguments: $rs, $where, $attrs
504 delete takes the name of a resultset from the schema_class, a where hashref and a attrs to pass to ->search.
505 The found data is deleted and cannot be recovered.
510 my ($self, $rs, $where, $attrs) = @_;
512 $rs ||= $self->resultset();
513 $where ||= $self->where();
514 $attrs ||= $self->attrs();
515 my $resultset = $self->schema->resultset($rs);
516 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
518 my $count = $resultset->count();
519 print "This action will delete $count ".ref($resultset)." records.\n" if (!$self->quiet);
521 if ( $self->force || $self->_confirm() ) {
522 $resultset->delete_all();
531 =item Arguments: $rs, $where, $attrs
535 select takes the name of a resultset from the schema_class, a where hashref and a attrs to pass to ->search.
536 The found data is returned in a array ref where the first row will be the columns list.
541 my ($self, $rs, $where, $attrs) = @_;
543 $rs ||= $self->resultset();
544 $where ||= $self->where();
545 $attrs ||= $self->attrs();
546 my $resultset = $self->schema->resultset($rs);
547 $resultset = $resultset->search( ($where||{}), ($attrs||()) );
550 my @columns = $resultset->result_source->columns();
551 push @data, [@columns];#
553 while (my $row = $resultset->next()) {
555 foreach my $column (@columns) {
556 push( @fields, $row->get_column($column) );
558 push @data, [@fields];
567 print "Are you sure you want to do this? (type YES to confirm) \n";
568 my $response = <STDIN>;
570 return ($response=~/^YES/);
574 my ($self, $cfg, $stanza) = @_;
575 my @path = split /::/, $stanza;
576 while (my $path = shift @path) {
577 if (exists $cfg->{$path}) {
578 $cfg = $cfg->{$path};
581 die ("Could not find $stanza in config, $path does not seem to exist.\n");
584 $cfg = $cfg->{connect_info} if exists $cfg->{connect_info};
588 =head1 FURTHER QUESTIONS?
590 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
592 =head1 COPYRIGHT AND LICENSE
594 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
595 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
596 redistribute it and/or modify it under the same terms as the
597 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.