view release on metacpan or  search on metacpan

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

package Class::Usul::Schema;

use namespace::autoclean;

use Class::Usul::Constants   qw( AS_PARA AS_PASSWORD EXCEPTION_CLASS COMMA
                                 FAILED FALSE NUL OK QUOTED_RE SPC TRUE );
use Class::Usul::Crypt::Util qw( encrypt_for_config );
use Class::Usul::Functions   qw( distname ensure_class_loaded io throw trim );
use Class::Usul::Types       qw( ArrayRef Bool HashRef Maybe NonEmptySimpleStr
                                 PositiveInt SimpleStr Str );
use Data::Record;
use Try::Tiny;
use Unexpected::Functions    qw( inflate_placeholders Unspecified );
use Moo;
use Class::Usul::Options;

extends q(Class::Usul::Programs);
with    q(Class::Usul::TraitFor::ConnectInfo);

# Attribute constructors
my $_build_connect_options = sub {
   my $self  = shift;
   my $copts = { password => NUL, user => NUL, };
   my $text  = 'Need the database administrators id and password';

   $self->output( $text, AS_PARA );

   my $prompt = '+Database administrator id';
   my $user = $self->db_admin_ids->{ lc $self->driver } || NUL;

   $copts->{user} = $self->get_line( $prompt, $user, TRUE, 0 );
   $prompt = '+Database administrator password';
   $copts->{password} = $self->get_line( $prompt, AS_PASSWORD );
   return $copts;
};

my $_build_qdb = sub {
   my $self = shift;
   my $cmds = $self->ddl_commands->{ lc $self->driver };
   my $code = $cmds ? $cmds->{ '-qualify_db' } : undef;

   return $code ? $code->( $self, $self->database ) : $self->database;
};

my $_connect_info = sub {
   my $self = shift;

   return $self->get_connect_info( $self, { database => $self->database } );
};

my $_extract_from_dsn = sub {
   my ($self, $field, $dsn) = @_;

   $self->options and $self->options->{bootstrap} and return;

   return (map  { s{ \A $field [=] }{}mx; $_ }
           grep { m{ \A $field [=] }mx }
           split  m{           [;] }mx, $dsn // $self->dsn)[ 0 ];
};

my $_qualify_database_path = sub {
   return $_[ 0 ]->config->datadir->catfile( $_[ 1 ].'.db' )->pathname;
};

my $_rebuild_dsn = sub {
   my $self = shift;
   my $dsn  = 'dbi:'.$self->driver.':database='.$self->_qualified_db;

   $self->host and $dsn .= ';host='.$self->host;
   $self->port and $dsn .= ';port='.$self->port;

   return $self->_set_dsn( $dsn );