gtsrssapi/lib/GTSRSSApi/DB.pm

105 lines
2.4 KiB
Perl

package GTSRSSApi::DB;
use v5.34.1;
use strict;
use warnings;
use DBI;
use DBD::Pg;
use GTSRSSApi::DB::Migrations;
use Data::Dumper;
my $dbh;
sub connect {
require GTSRSSApi;
if ( defined $dbh ) {
return $dbh;
}
my $class = shift;
my $app = GTSRSSApi->new;
my $config = $app->config;
my $database = $config->{db}{database};
$dbh = DBI->connect(
"dbi:Pg:dbname=$database",
undef, undef,
{
RaiseError => 1,
pg_enable_utf8 => 1,
Callbacks => {
connected => sub {
shift->do('set timezone = UTC');
return;
}
},
},
);
$class->_migrate($dbh);
return $dbh;
}
sub _migrate {
my $class = shift;
my $dbh = shift;
local $dbh->{RaiseError} = 0;
local $dbh->{PrintError} = 0;
my @migrations = GTSRSSApi::DB::Migrations::MIGRATIONS();
if ( $class->get_current_migration($dbh) > @migrations ) {
warn "Something happened there, wrong migration number.";
}
if ( $class->get_current_migration($dbh) >= @migrations ) {
say STDERR "Migrations already applied.";
return;
}
$class->_apply_migrations( $dbh, \@migrations );
}
sub _apply_migrations {
my $class = shift;
my $dbh = shift;
my $migrations = shift;
for (
my $i = $class->get_current_migration($dbh) ;
$i < @$migrations ;
$i++
)
{
local $dbh->{RaiseError} = 1;
my $current_migration = $migrations->[$i];
my $migration_number = $i + 1;
$class->_apply_migration( $dbh, $current_migration, $migration_number );
}
}
sub _apply_migration {
my $class = shift;
my $dbh = shift;
my $current_migration = shift;
my $migration_number = shift;
{
if ( ref $current_migration eq 'CODE' ) {
$current_migration->($dbh);
next;
}
$dbh->do($current_migration);
}
$dbh->do( <<'EOF', undef, 'current_migration', $migration_number );
INSERT INTO options
VALUES ($1, $2)
ON CONFLICT (name) DO
UPDATE SET value = $2;
EOF
}
sub get_current_migration {
my $class = shift;
my $dbh = shift;
my $result = $dbh->selectrow_hashref( <<'EOF', undef, 'current_migration' );
select value from options where name = ?;
EOF
return int( $result->{value} // 0 );
}
1;