view release on metacpan or  search on metacpan

lib/BusyBird/StatusStorage/SQLite.pm  view on Meta::CPAN

package BusyBird::StatusStorage::SQLite;
use v5.8.0;
use strict;
use warnings;
use parent ("BusyBird::StatusStorage");
use DBI;
use Carp;
use Try::Tiny;
use SQL::Maker 1.19;
use SQL::QueryMaker 0.03 qw(sql_and sql_eq sql_ne sql_or sql_lt sql_le sql_raw);
use BusyBird::DateTime::Format;
use BusyBird::Util qw(set_param);
use JSON;
use Scalar::Util qw(looks_like_number);
use DateTime::Format::Strptime;
use DateTime;
no autovivification;

my @STATUSES_ORDER_BY = ('utc_acked_at DESC', 'utc_created_at DESC', 'status_id DESC');
my $DELETE_COUNT_ID = 0;

my $UNDEF_TIMESTAMP = '9999-99-99T99:99:99';

{
    my $TIMESTAMP_FORMAT_STR = '%Y-%m-%dT%H:%M:%S';
    my $TIMESTAMP_FORMAT = DateTime::Format::Strptime->new(
        pattern => $TIMESTAMP_FORMAT_STR,
        time_zone => 'UTC',
        on_error => 'croak',
    );

    sub _format_datetime {
        my ($dt) = @_;
        return $dt->strftime($TIMESTAMP_FORMAT_STR);
    }

    sub _parse_datetime {
        my ($dt_str) = @_;
        return $TIMESTAMP_FORMAT->parse_datetime($dt_str);
    }
}


sub new {
    my ($class, %args) = @_;
    my $self = bless {
        maker => SQL::Maker->new(driver => 'SQLite', strict => 1),
        in_memory_dbh => undef,
    }, $class;
    $self->set_param(\%args, "path", undef, 1);
    $self->set_param(\%args, "max_status_num", 2000);
    $self->set_param(\%args, "hard_max_status_num", int($self->{max_status_num} * 1.2));
    $self->set_param(\%args, "vacuum_on_delete", int($self->{max_status_num} * 2.0));
    croak "max_status_num must be a number" if !looks_like_number($self->{max_status_num});
    croak "hard_max_status_num must be a number" if !looks_like_number($self->{hard_max_status_num});
    $self->{max_status_num} = int($self->{max_status_num});
    $self->{hard_max_status_num} = int($self->{hard_max_status_num});
    croak "hard_max_status_num must be >= max_status_num" if !($self->{hard_max_status_num} >= $self->{max_status_num});
    $self->_create_tables();
    return $self;
}

sub _create_new_dbh {
    my ($self, @connect_params) = @_;
    my $dbh = DBI->connect(@connect_params);
    $dbh->do(q{PRAGMA foreign_keys = ON});
    return $dbh;
}