view release on metacpan or  search on metacpan

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

  my $diff = $deploy->diff;
  return unless $diff->has_changes;

  if ($self->dry_run) {
    print "Summary:\n", $diff->summary, "\n\nSQL:\n", $diff->as_sql, "\n";
    return $diff;
  }

  my $allow = $self->force ? 1 : 0;
  # A refusing diff goes straight to apply, which throws; asking first would
  # offer a release that does not exist.
  my $refused = @{ $diff->classify->{refused} || [] };
  if (!$allow && !$refused && (my @risky = $diff->destructive_operations)) {
    print "This upgrade drops or may alter stored data:\n",
          (map { '  ' . $_->summary . "\n" } @risky);
    return 0 unless $self->_confirm;
    $allow = 1;
  }

  $deploy->apply($diff, allow_destructive => $allow);
  return $diff;
}

# The Deploy object of the schema's driver, or undef without a native path.
sub _native_deploy {
  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)');
    return $schema->pg_deploy;
  }

  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, $self->_all_option);
}


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($self->_all_option);
}


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) {