root/veekun/trunk/lib/Vee/Controller/Root.pm

package Vee::Controller::Root;

use strict;
use warnings;
use base 'Catalyst::Controller';

use Vee::Authorization;
use Vee::Utils;

use Data::Dumper;
use DBIx::Class::QueryLog;
use File::Path;
use Time::HiRes;
use Time::Out qw/timeout/;
use URI;
use XML::Feed;

# Sets the actions in this controller to be registered with no prefix
# so they function identically to actions created in Vee.pm
__PACKAGE__->config->{namespace} = '';

=head1 NAME

Vee::Controller::Root - Root Controller

=head1 SYNOPSIS

See L<Vee>.

=head1 DESCRIPTION

Root Controller, containing global defaults and begin/end actions.

=head1 METHODS

=cut

=head2 auto

=cut

sub auto : Private {
    my ($self, $c) = @_;
    my $s = $c->stash;
    
    # for execution time
    $s->{start_time} = Time::HiRes::time;
    
    # track SQL queries
    my $storage = $c->model('DBIC')->schema->storage;
    $s->{querylog} = new DBIx::Class::QueryLog;
    $storage->debugobj($s->{querylog});
    $storage->debug(1);

    if ($c->user) { $c->user->obj->time_active(time); $c->user->obj->update; }
    
    if ($c->flash and %{$c->flash}) {
        $s->{$_} = $c->flash->{$_} for qw/error_msg info_msg success_msg/;
    }

    $self->_do_periodic_tasks($c);
        
    return 1;
}

=head2 default

=cut

sub default : Private {
    my ($self, $c) = @_;

    my @path_parts = @{ $c->req->args };

    if (not -e $c->path_to('static', @path_parts) . '.tt') {
        $c->stash->{template} = '404.tt';
        return;
    }
    
    $c->stash->{additional_template_paths} = [ $c->path_to('static') ];
    $c->stash->{template} = join('/', @path_parts) . '.tt';

    if ($path_parts[0] eq 'dex') {
        $c->stash( %Vee::Dex::all );
    }

    # TODO: 404?
}

=head2 end

End action.  Does various debugging, error-handling, statistics, and caching
thingies.

=cut

sub end : ActionClass('RenderView') {
    my ($self, $c) = @_;
    my $s = $c->stash;

    # capture flagrant errors in prod
    if (not $c->debug and scalar @{ $c->error }) {
        eval {
            $c->model('DBIC::ErrorLog')->create({
                time    => time,
                user_id => $c->user ? $c->user->obj->id : 0,
                ip      => Vee::Utils::inet_aton($c->req->address),
                path    => $c->req->path,
                method  => $c->req->method,
                query   => Dumper($c->req->params),
                error   => join "\n", @{$c->error},
            });
        };

        $c->res->status(500);
        
        $s->{insert_error} = $@;
        $s->{errors}       = $c->error;  # XXX: not sure if I should expose these to the user

        $s->{template} = 'fatal.tt';
        
        $c->forward('Vee::View::TT');
        $c->error(0);
    }

    # count up SQL queries used
    if ($c->debug or $c->req->params->{dump_sql}) {
        my %perl_queries;
        for my $qt (@{ $s->{querylog}->log }) {
            if ($qt->isa('DBIx::Class::QueryLog::Query')) {
                $perl_queries{ $qt->sql }++
            } else {
                $perl_queries{ $_->sql }++ for @{ $qt->queries }
            }
        }

        # can't generate this list here as it won't count SQL run in the template
        $s->{generate_query_list} = sub {
            my ($log) = @_;
            # group queries together...
            my %queries;

            # List of actual query objects; log may contain transactions
            my @queries;
            for my $query_or_txn (@$log) {
                if ($query_or_txn->can('queries')) {
                    # Transaction
                    push @queries, @{ $query_or_txn->queries };
                }
                else {
                    push @queries, $query_or_txn;
                }
            }

            for my $query (@queries) {
                $queries{ $query->sql } ||= {
                    count    => 0,
                    count_pl => 0,
                    time     => 0,
                    sql      => $query->sql,
                };

                $queries{ $query->sql }{count} += $query->count;
                $queries{ $query->sql }{time} += $query->time_elapsed;
            }
            for my $query (keys %perl_queries) {
                $queries{$query}{count_pl} = $perl_queries{$query};
            }

            # ...and sort by time taken
            my @sorted_queries = sort { $b->{time} <=> $a->{time} } values %queries;
            return \@sorted_queries;
        }
    }

    # if _cache_fh is set, grab the output manually and cache it to disk
    # NOTE: THIS EXPECTS THAT A WRAPPER IS USED
    if ($s->{_cache_fh}) {
        # disable wrapper, then get just the body
        my $skip_wrapper = $s->{skip_wrapper};
        $s->{skip_wrapper} = 1;
        my $body = $c->view->render($c, $s->{template});

        # cache
        my $cache_file = $s->{_cache_fh};
        print $cache_file $body;
        flock $cache_file, 8;
        close $cache_file;

        $s->{skip_wrapper} = $skip_wrapper;
        $c->forward('/render_from_cache');

    # this is done here so the above querylog/etc code can run first
    } elsif ($s->{from_cache}) {
        $c->forward('/render_from_cache');
    }
}

=head2 cache

Uses the template in the stash and a provided scalar as a key to cache this
page.  If the cache already exists, it will be used and the rest of the calling
controller will be skipped.

=cut

sub cache : Private {
    my ($self, $c, $key) = @_;
    my $s = $c->stash;

    return if $c->debug;
    return if not $s->{template};

    $key = '' if not defined $key;
    $key =~ tr/-_a-zA-Z0-9//cd;
    $key = 'default' if not length $key;

    $s->{_cache_file} = "$s->{template}/$key";
    my $cache_path = $c->path_to(qw/ tmp cache /) . '/' . $s->{_cache_file};

    if (-e $cache_path) {
        # if the cache file exists, flag end() to spit it out
        $s->{from_cache} = 1;
        $c->detach;
    } else {
        # create directory tree; if there be a problem, just don't cache
        eval { mkpath( $c->path_to(qw/ tmp cache /) . '/' . $s->{template} ) };
        return if $@;

        # open here and flock to prevent race condition
        open my $cache_file, '>:encoding(UTF-8)',
            $c->path_to(qw/ tmp cache /, $s->{_cache_file});
        flock $cache_file, 2;
        $s->{_cache_fh} = $cache_file;
    }
}

=head2 render_from_cache

Used to...  render a template from the cache.  Mostly used as a hack to avoid
template compilation, but I'd also like to figure out how to get TT to simply
not parse the cached file at all.

=cut

sub render_from_cache : Private {
    my ($self, $c) = @_;
    my $s = $c->stash;

    open my $cache_file, '<:encoding(UTF-8)',
        $c->path_to(qw/ tmp cache /, $s->{_cache_file});
    $c->res->body( $c->view->render($c, $cache_file) );
    close $cache_file;
}

=head2 _do_periodic_tasks

Performs various actions if they haven't been done for some amount of time.

Regular method!  Not an action.

=cut

sub _do_periodic_tasks
{
    my ($self, $c) = @_;

    if ($c->cache->{_last_performed} and
        $c->cache->{_last_performed} > time - 15 * 60)
    {
        return;
    }

    # Last subversion commit
eval {
    open my $svn_fh, '-|', 'svn', 'log', '--limit' => 1, '--incremental', $c->site_opts->{svn_url};
    my (undef, $details, undef, @log) = <$svn_fh>;
    close $svn_fh;
    die "Couldn't get svn details" if not defined $details;

    my ($rev, $user, $time, undef) = split / \| /, $details;
    $rev =~ s/^r//;
    my ($yr, $mo, $day, $hr, $min, $sec, $tz) = split /[- :]/, $time, 7;

    $c->cache->{svn} = {
        revision     => $rev,
        user         => $user,
        time         => new DateTime(
            year   => $yr,
            month  => $mo,
            day    => $day,
            hour   => $hr,
            minute => $min,
            second => $sec,
            time_zone => substr $tz, 0, 5,
        ),
        log          => join '', @log,
    };
};

    # Refresh Bulbapedia feeds
eval {
    timeout 5, sub {
        my $uri = URI->new($c->site_opts->{rss_url});
        my @entries = XML::Feed->parse($uri)->entries;
        @entries = grep { defined }
            @entries[ 0 .. $c->site_opts->{page_sizes}{index}{rss} - 1 ];
        $c->cache->{rss_entries} = \@entries;
    };
};

    $c->cache->{_last_performed} = time;
}

=head1 AUTHOR

Maintainer: Alex "Eevee" Munroe (C<veekun@veekun.com>)

See the included F<AUTHORS> file for a full list of contributers.

=head1 LICENSE

See the included F<LICENSE> file.

=cut

1;