1#@!#!123s

��JFIF�� 1#@!#!123s
: / opt / PUC / lib / PUC / Module / WebApp /
Filename : SQLiteStore.pm
back
package PUC::Module::WebApp::SQLiteStore;
use strict;
use warnings;
use 5.010_001;

use parent 'Class::Accessor';
use DBD::SQLite;
use DBI;
use JSON ();

use Log::Log4perl;
Log::Log4perl->init_once('/opt/PUC/log4perl.conf');
my $log = Log::Log4perl->get_logger();

__PACKAGE__->mk_ro_accessors(qw/dsn/);

sub new {
    my ( $class, %options ) = @_;
    _build_dsn( \%options );
    return bless \%options, $class;
}

sub _build_dsn {
    my ($self) = @_;
    return $self->{dsn} //= 'dbi:SQLite:dbname=' . $self->{dbfile};
}

sub create_local_store {
    my ($self) = @_;
    my $dbh = DBI->connect_cached( $self->dsn );
    $dbh->do( <<'CREATE_SQL' );
        CREATE TABLE IF NOT EXISTS
        main.webapps (                      -- v1.0
            server   VARCHAR(255) NOT NULL,
            username VARCHAR(31)  NOT NULL,
            domain   TEXT         NOT NULL,
            data     TEXT         NOT NULL,
            updated  CHAR(20)     NOT NULL, -- ISO-8601 modified

            PRIMARY KEY (server, username, domain)
            ON CONFLICT FAIL
        )
CREATE_SQL
    return $self;
}

sub diff_and_save {
    my ( $self, $data ) = @_;
    my $json = JSON->new->utf8->canonical->encode($data);    ## no critic (ProhibitLongChains)
    my $dbh  = DBI->connect_cached( $self->dsn );

    ## no critic (RequireCarping, ProhibitLocal)
    local $dbh->{RaiseError} = 1;
    my $success = eval {                                     # try
        $dbh->begin_work;
        my $sth = $dbh->prepare( <<'SQL' );
    SELECT * FROM webapps
    WHERE server = ?
      AND username = ?
      AND domain = ?
    ORDER BY updated DESC -- PRIMARY KEY should prevent multiple records
SQL
        $sth->execute(
            $data->{server}->{hostname},
            $data->{username},
            $data->{domain}->{name},
        ) or die 'Query failed without raising exception!';

        my $result = $sth->fetchrow_hashref();
        die 'Fetch failed without raising exception! - ' . $sth->err
          if $sth->err;
        if ( $result && $sth->fetchrow_hashref() ) {
            die 'Foreign key constraint failed - multiple records!';
        }
        if ( !$result || $json ne $result->{data} ) {
            my $sth_u = $dbh->prepare( $result ? <<'SQL_UPDATE' : <<'SQL_INSERT' );
    UPDATE webapps SET data = ?, updated = datetime('now')
    WHERE server = ?
      AND username = ?
      AND domain = ?
SQL_UPDATE
    INSERT INTO webapps
    ( data, server, username, domain, updated )
    VALUES ( ?, ?, ?, ?, datetime('now') )
SQL_INSERT
            $sth_u->execute(
                $json,
                $data->{server}->{hostname},
                $data->{username},
                $data->{domain}->{name},
            ) or die 'INSERT or UPDATE failed without raising exception!';
            $result = { data => $json };
        }
        else {
            $result = {};
        }
        $dbh->commit;
        return $result;
    };
    if ( !$success ) {    # catch
        ## no critic (BracedFileHandle CheckedSyscalls)
        my $err = $@;
        eval { $dbh->rollback };    ## no critic (CheckingReturnValue)

        $log->error(__PACKAGE__ . ": Failed to query database:".$err, action => "PUC::Module::WebApp::SQLiteStore->diff_and_save");

        print STDERR __PACKAGE__ . ": Failed to query database: $err\n";

        # don't report if there is a database error
        return;
    }
    return $success->{data};        # json string or undef
}

1;