view release on metacpan or  search on metacpan

lib/DBIO/Admin.pm  view on Meta::CPAN

sub _build_config {
  my ($self) = @_;

  _require_module('Config::Any', 'Config::Any is required to parse --config files');
  my $cfg = Config::Any->load_files({
    files => [$self->config_file],
    use_ext => 1,
    flatten_to_hash => 1,
  });

  $cfg = $cfg->{$self->config_file};
  return $cfg;
}

sub upgrade {
  my ($self) = @_;
  my $mode = lc($self->mode || 'auto');
  Carp::croak("Unsupported mode '$mode' (expected auto|native)")
    unless $mode =~ /\A(?:auto|native)\z/;

  my $native = $self->_upgrade_native;
  return $native if defined $native;

  Carp::croak('No native upgrade path available for this schema/driver');
}

sub _upgrade_native {
  my ($self) = @_;
  my $schema = $self->schema;

  # PostgreSQL-native upgrade path from DBIO-PostgreSQL
  if ($schema->can('pg_deploy')) {
    _require_module('DBIO::PostgreSQL::Deploy',
      'Native PostgreSQL upgrade requires DBIO-PostgreSQL (install DBIO::PostgreSQL)');
    my $deploy = $schema->pg_deploy;
    return $deploy->upgrade;
  }

  return undef;
}

sub deploy {
  my ($self, $args) = @_;
  return $self->schema->deploy($args, $self->sql_dir);
}

sub insert {
  my ($self, $rs, $set) = @_;

  $rs ||= $self->resultset;
  $set ||= $self->set;
  Carp::croak('insert requires --resultset/--class and --set') unless $rs && $set;

  my $resultset = $self->schema->resultset($rs);
  my $obj = $resultset->new_result($set)->insert;
  print ''.ref($resultset).' ID: '.join(',', $obj->id)."\n" if !$self->quiet;
  return $obj;
}

sub update {
  my ($self, $rs, $set, $where) = @_;

  $rs ||= $self->resultset;
  $set ||= $self->set;
  $where ||= $self->where || {};
  Carp::croak('update requires --resultset/--class and --set') unless $rs && $set;

  my $resultset = $self->schema->resultset($rs)->search($where);
  if (!$self->quiet) {
    my $count = eval { $resultset->count };
    if (defined $count && !$@) {
      print "This action will modify $count ".ref($resultset)." records.\n";
    }
    else {
      print "This action will modify matching ".ref($resultset)." records.\n";
    }
  }

  return 0 unless $self->force || $self->_confirm;
  return $resultset->update_all($set);
}

sub delete {
  my ($self, $rs, $where, $attrs) = @_;

  $rs ||= $self->resultset;
  $where ||= $self->where || {};
  $attrs ||= $self->attrs || {};
  Carp::croak('delete requires --resultset/--class') unless $rs;

  my $resultset = $self->schema->resultset($rs)->search($where, $attrs);
  if (!$self->quiet) {
    my $count = eval { $resultset->count };
    if (defined $count && !$@) {
      print "This action will delete $count ".ref($resultset)." records.\n";
    }
    else {
      print "This action will delete matching ".ref($resultset)." records.\n";
    }
  }

  return 0 unless $self->force || $self->_confirm;
  return $resultset->delete_all;
}

sub select {
  my ($self, $rs, $where, $attrs) = @_;

  $rs ||= $self->resultset;
  $where ||= $self->where || {};
  $attrs ||= $self->attrs || {};
  Carp::croak('select requires --resultset/--class') unless $rs;

  my $resultset = $self->schema->resultset($rs)->search($where, $attrs);
  my @columns = $resultset->result_source->columns;
  my @data = ( [ @columns ] );

  while (my $row = $resultset->next) {
    push @data, [ map { $row->get_column($_) } @columns ];
  }