view release on metacpan or  search on metacpan

lib/App/RoboBot.pm  view on Meta::CPAN

    my ($self, $network, $macro_name) = @_;

    my $logger = $self->logger('core.macro');

    $logger->debug(sprintf('Removing macro %s on %s network.', $macro_name, $network->name));

    return unless exists $self->macros->{$network->id}{$macro_name};

    $self->macros->{$network->id}{$macro_name}->delete;
    delete $self->macros->{$network->id}{$macro_name};

    $logger->debug('Macro successfully removed.');

    return 1;
}

sub network_by_id {
    my ($self, $network_id) = @_;

    return undef unless defined $network_id && $network_id =~ m{^\d+$};
    return (grep { $_->id == $network_id } @{$self->networks})[0] || undef;
}

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

    my $logger = $self->logger('core.migrate');

    $logger->info('Checking database migration status.');

    my $migrations_dir = dist_dir('App-RoboBot') . '/migrations';
    die "Could not locate database migrations (remember to use `dzil run` during development)!"
        unless -d $migrations_dir;

    my $cfg = $self->config->config->{'database'}{'primary'};

    my $db_uri = 'db:pg://';
    $db_uri .= $cfg->{'user'} . '@' if $cfg->{'user'};
    $db_uri .= $cfg->{'host'} if $cfg->{'host'};
    $db_uri .= ':' . $cfg->{'port'} if $cfg->{'port'};
    $db_uri .= '/' . $cfg->{'database'} if $cfg->{'database'};

    $logger->debug(sprintf('Using database URI %s for migration status check.', $db_uri));

    chdir($migrations_dir) or die "Could not chdir() $migrations_dir: $!";

    open(my $status_fh, '-|', 'sqitch', 'status', $db_uri) or die "Could not check database status: $!";
    while (my $l = <$status_fh>) {
        if ($l =~ m{up-to-date}) {
            $logger->info('Database schema up to date. No migrations run.');
            return;
        }
    }
    close($status_fh);

    die "Database schema is out of date, but --migrate was not specified so we cannot upgrade.\n"
        unless $self->do_migrations;

    $logger->info('Migration necessary. Running with verification enabled.');

    open(my $deploy_fh, '-|', 'sqitch', 'deploy', '--verify', $db_uri) or die "Could not begin database migrations: $!";
    while (my $l = <$deploy_fh>) {
        if ($l =~ m{^\s*\+\s*(.+)\s+\.\.\s+(.*)$}) {
            die "Failed during database migration $1.\n" if lc($2) ne 'ok';
        }
    }
    close($deploy_fh);

    $logger->info('Database migration completed successfully.');
}

__PACKAGE__->meta->make_immutable;

1;