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

package Vee::Controller::Root;

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

use Time::HiRes;
use Data::Dumper;
use DBIx::Class::QueryLog;
use File::Path;
use Vee::Authorization;
use Vee::Utils;

# 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/;
    }
        
    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;
            for my $query (@$log) {
                $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 @queries = sort { $b->{time} <=> $a->{time} } values %queries;
            return \@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, '>', $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, '<', $c->path_to(qw/ tmp cache /, $s->{_cache_file} );
    $c->res->body( $c->view->render($c, $cache_file) );
    close $cache_file;
}

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