explain.depesz.com/lib/Explain/Plugin/Database.pm

package Explain::Plugin::Database;

use Mojo::Base 'Mojolicious::Plugin';

use Mojo::Util 'trim';

use Carp;
use DBI;
use Date::Simple;
use English qw( -no_match_vars );

has real_dbh        => undef;
has connection_args => sub { [] };
has log             => undef;

sub register {
    my ( $self, $app, $config ) = @_;

    # data source name
    my $dsn = $config->{ dsn };

    # if DSN not set directly
    unless ( $dsn ) {

        # driver
        my $driver = $config->{ driver } || 'Pg';

        # database name
        my $database = $config->{ database } || lc( $ENV{ MOJO_APP } );

        # assemble
        my $dsn = sprintf 'dbi:%s:database=%s', $driver, $database;

        $dsn .= ';host=' . $config->{ host } if $config->{ host };
        $dsn .= ';port=' . $config->{ port } if $config->{ port };
    }

    # database (DBI) connection arguments
    $self->connection_args(
        [
            $config->{ dsn },
            $config->{ username },
            $config->{ password },
            $config->{ options } || {}
        ]
    );

    # log debug message
    $app->log->debug( 'Database connection args: ' . $app->dumper( $self->connection_args ) );
    $self->log( $app->log );

    # register helper
    $app->helper(
        database => sub {
            return $self;
        }
    );

    return;
}

sub dbh {
    my $self = shift;

    if (   ( $self->real_dbh )
        && ( $self->real_dbh->state =~ m{^(08|S8|57)} ) )
    {
        $self->log->warn( 'DBH looks errored out, state ' . $self->real_dbh->state . ', reconnecting.' );
        $self->real_dbh( undef );
    }

    $self->real_dbh( DBI->connect( @{ $self->connection_args } ) ) unless $self->real_dbh;

    return $self->real_dbh;
}

sub user_login {
    my $self = shift;
    my ( $username, $password ) = @_;

    my @row = $self->dbh->selectrow_array(
        'SELECT password, is_admin FROM users where username = ?',
        undef,
        $username,
    );
    return if 0 == scalar @row;
    my $crypted = crypt( $password, $row[ 0 ] );

    return if $crypted ne $row[ 0 ];
    return { 'admin' => $row[1] };
}

sub user_change_password {
    my $self = shift;
    my ( $username, $old, $new ) = @_;

    my @row = $self->dbh->selectrow_array(
        'SELECT password FROM users where username = ?',
        undef,
        $username,
    );
    return if 0 == scalar @row;
    my $crypted_old = crypt( $old, $row[ 0 ] );

    my $crypted_new = crypt( $new, $self->get_pw_salt() );

    @row = $self->dbh->selectrow_array(
        'UPDATE users SET password = ? WHERE ( username, password ) = ( ?, ? ) returning username',
        undef,
        $crypted_new, $username, $crypted_old,
    );
    return 1 if 1 == scalar @row;
    return;
}

sub get_user_history {
    my $self = shift;
    my ( $user, $direction, $marker ) = @_;

    my $limit = 100;

    $direction = 'DESC' if ( $direction // '' ) ne 'ASC';
    my $query = '';
    my @args  = ();

    if ( defined $marker ) {
        my $comparison = $direction eq 'DESC' ? '<' : '>';
        $query = "
            SELECT p.id, p.entered_on::date, p.is_public, p.is_anonymized, p.title
            FROM plans p
            WHERE p.added_by = ? and not p.is_deleted
            AND ( p.entered_on, p.id ) $comparison (
                    select x.entered_on, x.id
                    from plans x
                    where x.id = ?
                )
            ORDER BY p.entered_on $direction, p.id $direction LIMIT $limit
            ";
        @args = ( $user, $marker );

    }
    else {
        $query = "
            SELECT p.id, p.entered_on::date, p.is_public, p.is_anonymized, p.title
            FROM plans p
            WHERE p.added_by = ? and not p.is_deleted
            ORDER BY p.entered_on DESC, p.id DESC LIMIT $limit
            ";
        @args = ( $user );
    }
    my $plans = $self->dbh->selectall_arrayref( $query, { Slice => {} }, @args );

    # newest plans always first
    $plans = [ reverse @{ $plans } ] if $direction eq 'ASC';

    return {
        'list'    => [],
        'earlier' => 0,
        'later'   => 0,
    } if 0 == scalar @{ $plans };

    my @later = $self->dbh->selectrow_array(
        'SELECT p.id FROM plans p where p.added_by = ? and not is_deleted and ( p.entered_on, p.id ) > ( select x.entered_on, x.id from plans x where x.id = ? ) limit 1',
        undef,
        $user, $plans->[ 0 ]->{ 'id' },
    );
    my @earlier = $self->dbh->selectrow_array(
        'SELECT p.id FROM plans p where p.added_by = ? and not is_deleted and ( p.entered_on, p.id ) < ( select x.entered_on, x.id from plans x where x.id = ? ) limit 1',
        undef,
        $user, $plans->[ -1 ]->{ 'id' },
    );
    return {
        'list'    => $plans,
        'later'   => scalar @later,
        'earlier' => scalar @earlier,
    };
}

sub get_pw_salt {
    my $self       = shift;
    my @salt_chars = ( 'a' .. 'z', 'A' .. 'Z', 0 .. 9, '.', '/' );
    my $salt       = sprintf '$6$%s$', join( '', map { $salt_chars[ rand @salt_chars ] } 1 .. 16 );
    return $salt;
}

sub user_register {
    my $self = shift;
    my ( $username, $password ) = @_;

    my $crypted = crypt( $password, $self->get_pw_salt() );

    eval { $self->dbh->do( 'INSERT INTO users (username, password, registered) values (?, ?, now())', undef, $username, $crypted, ); };
    return 1 unless $EVAL_ERROR;
    $self->log->error( "user_register( $username ) => " . $EVAL_ERROR );
    return;
}

sub update_plan {
    my $self = shift;
    my ( $id, $changes ) = @_;
    my @columns = keys %{ $changes };
    my @values  = values %{ $changes };

    eval {
        $self->dbh->do(
            'UPDATE plans SET ' . join( ', ', map { "$_ = ?" } @columns ) . ' WHERE id = ?',
            undef,
            @values, $id
        );
    };
    return 1 unless $EVAL_ERROR;
    $self->log->error( "update_plan( $id ) => " . $EVAL_ERROR );
    return;
}

sub save_with_random_name {
    my $self = shift;
    my ( $title, $content, $is_public, $is_anon, $username, $optimization_for ) = @_;

    my @row = $self->dbh->selectrow_array(
        'SELECT id, delete_key FROM register_plan(?, ?, ?, ?, ?, ?)',
        undef,
        $title, $content, $is_public, $is_anon, $username, $optimization_for,
    );

    # return id and delete_key
    return @row;
}

sub ping {
    my $self = shift;
    return $self->dbh->ping();
}

sub get_plan_data {
    my $self = shift;
    my ( $plan_id ) = @_;

    my $rows = $self->dbh->selectall_arrayref(
        'SELECT * FROM plans WHERE id = ? AND NOT is_deleted',
        { Slice => {} },
        $plan_id,
    );
    return unless defined $rows;
    return if 0 == scalar @{ $rows };
    return $rows->[ 0 ];
}

sub get_plan {
    my $self = shift;
    my ( $plan_id ) = @_;

    my @row = $self->dbh->selectrow_array(
        'SELECT plan, title, optimization_for FROM plans WHERE id = ? AND NOT is_deleted',
        undef,
        $plan_id,
    );

    # return plan
    return @row;
}

sub get_optimization_path {
    my $self = shift;
    my ($plan_id) = @_;

    my $rows = $self->dbh->selectall_arrayref(
        '
            WITH RECURSIVE path AS (
                SELECT id, title, optimization_for, 0 as level FROM plans WHERE id = ? and not is_deleted
                union all
                SELECT p.id, p.title, p.optimization_for, x.level + 1
                    FROM path x
                    join plans p on p.id = x.optimization_for
                    WHERE NOT p.is_deleted
                        AND x.optimization_for IS NOT NULL
            )
            SELECT
                id, title
            FROM
                path
            ORDER BY level desc;
        ',
        { Slice => {} },
        $plan_id,
    );
    return if 0 == scalar @{ $rows };
    return if 1 == scalar @{ $rows };
    return $rows;
}

sub get_optimizations_for {
    my $self = shift;
    my ($plan_id) = @_;
    my $rows = $self->dbh->selectall_arrayref(
        'select id, title from plans where optimization_for = ? and not is_deleted',
        { Slice => {} },
        $plan_id
    );
    return if 0 == scalar @{ $rows };
    return $rows;
}

sub plan_exists {
    my $self = shift;
    my ( $plan_id ) = @_;

    my @row = $self->dbh->selectrow_array(
        'SELECT 1 FROM plans WHERE id = ? AND NOT is_deleted',
        undef,
        $plan_id,
    );
    return if 0 == scalar @row;
    return 1;
}

sub delete_plan {
    my $self = shift;
    my ( $plan_id, $delete_key ) = @_;
    my @row = $self->dbh->selectrow_array(
        'UPDATE plans SET plan = ?, title = ?, is_deleted = true, delete_key = NULL WHERE id = ? and delete_key = ? RETURNING 1',
        undef,
        '',
        'This plan has been deleted.',
        $plan_id,
        $delete_key
    );
    return 1 if $row[ 0 ];
    return;
}

sub get_public_list {
    my $self = shift;

    return $self->dbh->selectall_arrayref(
        'SELECT id, to_char( entered_on, ? ) as date FROM plans WHERE is_public ORDER BY entered_on DESC',
        { Slice => {} },
        'YYYY-MM-DD'
    );
}

sub get_public_list_paged {
    my $self = shift;

    # param "date"
    my $date = defined( $_[ 0 ] ) ? $_[ 0 ] : '';

    # trim
    trim $date;

    # today
    my $today = Date::Simple->new;

    # scalar $date to Date::Simple
    my $to = eval { Date::Simple->new( $date ) };

    # error
    unless ( $to ) {

        # invalid date, like: 2010-02-31
        return { error => qq|Invalid date "$date" given.| }
            if $date =~ /\A\d\d\d\d\-\d\d\-\d\d\z/;

        # invalid format
        return { error => qq|Invalid value "$date" given.| }
            if length $date;

        # fallback
        $to = $today;
    }

    # time travel exception
    return { error => qq|Date "$date" is in future!| } if $to > $today;

    # since SCALAR value
    my $since = ( $to - 7 )->as_str( '%Y-%m-%d' );

    # select
    my $rows = $self->dbh->selectall_arrayref(
        'SELECT id, to_char( entered_on, ? ) as date
           FROM plans
          WHERE is_public
            AND entered_on > ?::date
            AND entered_on < ?::date
            AND NOT is_deleted
       ORDER BY entered_on
           DESC',
        { Slice => {} },
        'YYYY-MM-DD',
        $since,
        ( $to + 1 )->as_str( '%Y-%m-%d' )
    );

    # next week
    my $next = $to + 7;
    $next = ( $next > $today ) ? undef : $next->as_str( '%Y-%m-%d' );

    return {
        since     => $since,
        to        => $to->as_str( '%Y-%m-%d' ),
        rows      => $rows || [],
        next_date => $next,
        prev_date => ( $to - 8 )->as_str( '%Y-%m-%d' )
    };
}

sub DESTROY {
    my $self = shift;

    # nothing to do...
    return unless $self->dbh;

    # rollback uncommited transactions
    $self->dbh->rollback unless $self->connection_args->[ 3 ]->{ auto_commit };

    # disconnect
    $self->dbh->disconnect;

    $self->dbh( undef );

    return;
}

1;