Class-Usul

 view release on metacpan or  search on metacpan

lib/Class/Usul/Schema.pm  view on Meta::CPAN

   for my $schema_class (values %{ $self->schema_classes }) {
      ensure_class_loaded  $schema_class;
      $self->dry_run and $self->output( "Would create ${schema_class}" )
                     and next;
      $self->$_create_ddl( $schema_class, $self->config->sharedir );
   }

   return OK;
}

sub create_schema : method { # Create databases and edit credentials
   my $self    = shift;
   my $default = $self->yes;
   my $text    = 'Schema creation requires a database, id and password. '
               . 'For Postgres the driver is Pg and the port 5432. For '
               . 'MySQL the driver is mysql and the port 3306';

   $self->output( $text, AS_PARA );
   $self->yorn( '+Create database schema', $default, TRUE, 0 ) or return OK;
   $self->edit_credentials;
   $self->connect_options;
   $self->drop_database;
   $self->drop_user;
   $self->create_user;
   $self->create_database;
   $self->deploy_and_populate;
   return OK;
}

sub create_user : method {

lib/Class/Usul/Schema.pm  view on Meta::CPAN

   $self->$_test_for_existance( $copts, $cmds->{exists_user}, @args )
      or return OK;
   $self->info( "Droping ${driver} user ${user}" );

   my $r = $self->execute_ddl( $_inflate->( $ddl, @args ), $copts, $cmd_opts );

   $self->debug and $self->dumper( $r );
   return OK;
}

sub edit_credentials : method {
   my $self      = shift;
   my $self_cfg  = $self->config;
   my $db        = $self->database;
   my $bootstrap = $self->options->{bootstrap};
   my $cfg_data  = $bootstrap ? {} : $self->load_config_data( $self_cfg, $db );
   my $copts     = $bootstrap ? {}
                 : $self->extract_creds_from( $self_cfg, $db, $cfg_data );
   my $stored_pw = $copts->{password};
   my $prompts   = { name     => 'Database name',
                     driver   => 'Driver type',

lib/Class/Usul/Schema.pm  view on Meta::CPAN

      my $is_pw  = $field eq 'password' ? TRUE : FALSE;
      my $value  = $defaults->{ $field } ne '_field' ? $defaults->{ $field }
                                                     :    $copts->{ $field };

      $value = $self->get_line( $prompt, $value, TRUE, 0, FALSE, $is_pw );
      $field ne 'name' and $self->$setter( $value // NUL );
      $is_pw and $value = encrypt_for_config $self_cfg, $value, $stored_pw;
      $copts->{ $field } = $value // NUL;
   }

   $cfg_data->{credentials}->{ $copts->{name} } = $copts;
   $self->dry_run and $self->dumper( $cfg_data ) and return OK;
   $self->dump_config_data( $self_cfg, $copts->{name}, $cfg_data );
   return OK;
}

sub execute_ddl {
   my ($self, $ddl, $connect_opts, $cmd_opts) = @_;

   my $drvr = $connect_opts->{driver  } // lc $self->driver;
   my $db   = $connect_opts->{database} // $self->db_admin_accounts->{ $drvr };

lib/Class/Usul/Schema.pm  view on Meta::CPAN

=head2 create_ddl - Dump the database schema definition

   $self->create_ddl;

Creates the DDL for multiple RDBMs

=head2 create_schema - Creates a database then deploys and populates the schema

   $self->create_schema;

Calls L<edit_credentials>, L<create_database>, L<create_user>, and
L<deploy_and_populate>

=head2 create_user - Creates a database user

   $self->create_user;

Creates a database user

=head2 deploy_and_populate - Create tables and populates them with initial data

lib/Class/Usul/Schema.pm  view on Meta::CPAN

The user is selected by the C<user> attribute

=head2 dsn

   $self->dsn;

Returns the DSN from the call to
L<get_connect_info|Class::Usul::TraitFor::ConnectInfo/get_connect_info>

=head2 edit_credentials - Edits the database login information

   $self->edit_credentials;

Encrypts the database connection password before storage

=head2 execute_ddl

   $self->execute_ddl( $ddl, \%connect_opts, \%command_opts );

Executes the DDL

=head2 host

lib/Class/Usul/TraitFor/ConnectInfo.pm  view on Meta::CPAN

};

my $_get_cache_key = sub {
   my $param = shift;
   my $db    = $param->{database}
      or throw 'Class [_1] has no database name', [ $param->{class} ];

   return $param->{subspace} ? "${db}.".$param->{subspace} : $db;
};

my $_get_credentials_file = sub {
   my $param = shift; my $file = $param->{ctlfile};

   defined $file and -f $file and return $file;

   my $dir = $param->{ctrldir}; my $db = $param->{database};

      $dir or throw Unspecified, [ 'ctrldir' ];
   -d $dir or throw 'Directory [_1] not found', [ $dir ];
       $db or throw 'Class [_1] has no database name', [ $param->{class} ];

lib/Class/Usul/TraitFor/ConnectInfo.pm  view on Meta::CPAN

my $_unicode_options = sub {
   return { mysql  => { mysql_enable_utf8 => TRUE },
            pg     => { pg_enable_utf8    => TRUE },
            sqlite => { sqlite_unicode    => TRUE }, };
};

my $_dump_config_data = sub {
   my ($param, $cfg_data) = @_;

   my $ctlfile = $_get_credentials_file->( $param );
   my $schema  = $_get_dataclass_schema->( $param->{dataclass_attr} );

   return $schema->dump( { data => $cfg_data, path => $ctlfile } );
};

my $_extract_creds_from = sub {
   my ($param, $cfg_data) = @_; my $key = $_get_cache_key->( $param );

   ($cfg_data->{credentials} and defined $cfg_data->{credentials}->{ $key })
      or throw 'Path [_1] database [_2] no credentials',
               [ $_get_credentials_file->( $param ), $key ];

   return $cfg_data->{credentials}->{ $key };
};

my $_get_connect_options = sub {
   my $creds = shift;
   my $uopt  = $creds->{unicode_option}
            // $_unicode_options->()->{ lc $creds->{driver} } // {};

   return { AutoCommit =>  $creds->{auto_commit  } // TRUE,
            PrintError =>  $creds->{print_error  } // FALSE,
            RaiseError =>  $creds->{raise_error  } // TRUE,
            %{ $uopt }, %{ $creds->{database_attr} // {} }, };
};

my $_load_config_data = sub {
   my $schema = $_get_dataclass_schema->( $_[ 0 ]->{dataclass_attr} );

   return $schema->load( $_get_credentials_file->( $_[ 0 ] ) );
};

# Private methods
my $_merge_attributes = sub {
   return merge_attributes { class => blessed $_[ 0 ] || $_[ 0 ] },
                  $_[ 1 ], ($_[ 2 ] // {}), $_connect_attr->();
};

# Public methods
sub dump_config_data {

lib/Class/Usul/TraitFor/ConnectInfo.pm  view on Meta::CPAN

=head1 Description

Provides the DBIC connect information array reference

=head1 Configuration and Environment

The JSON data looks like this:

  {
     "credentials" : {
        "schedule" : {
           "driver" : "mysql",
           "host" : "localhost",
           "password" : "{Twofish}U2FsdGVkX1/xcBKZB1giOdQkIt8EFgfNDFGm/C+fZTs=",
           "port" : "3306",
           "user" : "username"
        }
     }
   }

t/19file.t  view on Meta::CPAN

     log        => Logger->new, );

my $cuf = Class::Usul::File->new( builder => $cu );

isa_ok $cuf, 'Class::Usul::File';
is $cuf->tempdir, 't', 'Temporary directory is t';

my $tf   = [ qw( t test.json ) ];
my $fdcs = $cuf->dataclass_schema->load( $tf );

is $fdcs->{credentials}->{test}->{driver}, 'sqlite',
   'File::Dataclass::Schema can load';

unlink catfile( qw( t ipc_srlock.lck ) );
unlink catfile( qw( t ipc_srlock.shm ) );

my $tempfile = $cuf->tempfile;

ok $tempfile, 'Returns tempfile';

is ref $tempfile->io_handle, 'File::Temp', 'Tempfile io handle correct class';

t/test.json  view on Meta::CPAN

{
   "credentials" : {
      "test" : {
         "driver" : "sqlite",
         "host" : "localhost",
         "password" : "test",
         "port" : "3306",
         "user" : "root"
      }
   }
}