view release on metacpan or  search on metacpan

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

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;
}

sub _get_my_dbh {
    my ($self) = @_;
    my @connect_params = ("dbi:SQLite:dbname=$self->{path}", "", "", {
        RaiseError => 1, PrintError => 0, AutoCommit => 1, sqlite_unicode => 1,
    });
    if($self->{path} eq ':memory:') {
        $self->{in_memory_dbh} = $self->_create_new_dbh(@connect_params) if !$self->{in_memory_dbh};
        return $self->{in_memory_dbh};
    }
    return $self->_create_new_dbh(@connect_params);
}

sub _create_tables {
    my ($self) = @_;
    my $dbh = $self->_get_my_dbh();
    $dbh->do(<<EOD);
CREATE TABLE IF NOT EXISTS timelines (
  timeline_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
  name TEXT UNIQUE NOT NULL
)
EOD
    $dbh->do(<<EOD);
CREATE TABLE IF NOT EXISTS statuses (
  timeline_id INTEGER NOT NULL
              REFERENCES timelines(timeline_id) ON DELETE CASCADE ON UPDATE CASCADE,
  status_id TEXT NOT NULL,
  utc_acked_at TEXT NOT NULL,
  utc_created_at TEXT NOT NULL,
  timezone_acked_at TEXT NOT NULL,
  timezone_created_at TEXT NOT NULL,
  level INTEGER NOT NULL,
  content TEXT NOT NULL,

  PRIMARY KEY (timeline_id, status_id)
)
EOD
    $dbh->do(<<EOD);
CREATE TABLE IF NOT EXISTS delete_counts (
  delete_count_id INTEGER PRIMARY KEY NOT NULL,
  delete_count INTEGER NOT NULL
)
EOD
    my ($sql, @bind) = $self->{maker}->insert('delete_counts', [
        delete_count_id => $DELETE_COUNT_ID, delete_count => 0
    ], {prefix => 'INSERT OR IGNORE INTO'});
    $dbh->do($sql, undef, @bind);
}

sub _record_hash_to_array {
    my ($record) = @_;
    return [ map { $_, $record->{$_} } sort { $a cmp $b } keys %$record ];
}

sub _put_update {
    my ($self, $dbh, $record, $prev_sth) = @_;
    my $sth = $prev_sth;
    my ($sql, @bind) = $self->{maker}->update('statuses', _record_hash_to_array($record), sql_and([
        sql_eq('timeline_id' => $record->{timeline_id}), sql_eq(status_id => $record->{status_id})
    ]));
    if(!$sth) {
        ## Or, should we check $sql is not changed...?
        $sth = $dbh->prepare($sql);
    }
    return ($sth->execute(@bind), $sth);