view release on metacpan or  search on metacpan

lib/Ado/Plugin/AdoHelpers.pm  view on Meta::CPAN

package Ado::Plugin::AdoHelpers;
use Mojo::Base 'Ado::Plugin';
use Mojo::Util qw(decode);
use List::Util qw(first);
use Mojo::File 'path';

# allow plugins to process SQL scripts while loading
sub do_sql_file {
    my ($app, $sql_file) = @_;
    my $dbh = $app->dbix->dbh;

    #$app->log->debug('do_sql_file:' . $sql_file) if $Ado::Control::DEV_MODE;

    my $SQL = decode('UTF-8', path($sql_file)->slurp());

    #Remove multi-line comments
    $SQL =~ s|/\*+.+?\*/\s+?||gsmx;

    #$app->log->debug('$SQL:' . $SQL) if $Ado::Control::DEV_MODE;
    local $dbh->{RaiseError} = 1;
    my $last_statement = '';
    return eval {
        $dbh->begin_work;
        for my $st (split /;/smx, $SQL) {
            $last_statement = $st;
            $dbh->do($st) if ($st =~ /\S+/smx);
        }
        $dbh->commit;
    } || do {
        my $e = "\nError in statement:$last_statement\n$@";
        my $e2;
        eval { $dbh->rollback } || ($e2 = $/ . 'Additionally we have a rollback error:' . $@);
        $app->log->error($e . ($e2 ? $e2 : ''));
        Carp::croak($e . ($e2 ? $e2 : ''));
    };
}

sub register {
    my ($self, $app, $conf) = shift->initialise(@_);

    # Add helpers
    $app->helper(user => sub { shift->user(@_) });

    # http://irclog.perlgeek.de/mojo/2014-10-03#i_9453021
    $app->helper(to_json => sub { Mojo::JSON::to_json($_[1]) });
    Mojo::Util::monkey_patch(ref($app), do_sql_file => \&Ado::Plugin::AdoHelpers::do_sql_file);

    $app->helper('head_css'        => \&_head_css);
    $app->helper('head_javascript' => \&_head_javascript);

    return $self;
}    #end of register

my $file_re = qr/\w+\.\w+(\?.*)?$/;

sub _head_css {
    my ($c, $assets) = @_;
    my $assets_list = $c->stash('head_css');

    #append
    if ($assets) {
        $assets = [$assets] unless ref($assets) eq 'ARRAY';
        foreach my $a (@$assets) {
            push @$assets_list, $a unless first { $_ eq $a } @$assets_list;
        }
        return;
    }

    # render
    my $css = '';

    #everything in separate stylesheet begin end block or <link>
    foreach my $a (@$assets_list) {
        if ($a =~ $file_re) {    # a file
            $css .= qq|<link href="$a" rel='stylesheet' type='text/css' />\n|;
        }
        elsif (ref $a eq 'CODE') {    # a code
            $css .= $c->stylesheet($a) . $/;
        }
        else {                        # a string
            $css .= $c->stylesheet(sub {$a}) . $/;
        }
    }
    return $css;
}

sub _head_javascript {
    my ($c, $assets) = @_;
    my $assets_list = $c->stash('head_javascript');

    #append
    if ($assets) {
        $assets = [$assets] unless ref($assets) eq 'ARRAY';