root/veekun/trunk/lib/Vee.pm

package Vee;

#BEGIN { use Carp; *CORE::GLOBAL::die = \&Carp::confess; }

use strict;
use warnings;

use Image::Size;
use LWP::UserAgent;
use Storable qw/dclone/;
use Time::Out qw/timeout/;
use YAML qw//;

# load crap
# first group are DEBUG-ONLY!
use Catalyst qw/
    -Debug
    StackTrace
    Static::Simple
    
    ConfigLoader
    Unicode
    
    Authentication
    Authentication::Store::DBIC
    Authentication::Credential::Password
    
    Session
    Session::Store::DBIC
    Session::State::Cookie
/;
use Vee::BBCode;
use Vee::Authorization;
use Vee::Utils;
use Vee::Dex;

our $VERSION = '0.01';

=head1 NAME

Vee - Code for veekun.com

=head1 SYNOPSIS

    script/vee_server.pl

=head1 DESCRIPTION

Codebase for veekun.com; includes a forum, Pokedex, gallery, and other such
generic website things.

=cut


# have to get site config before setup so controller init can play with options
my $siteopt_source = 'site_options.yml';
__PACKAGE__->config->{site} = YAML::LoadFile( __PACKAGE__->path_to($siteopt_source) );

__PACKAGE__->setup;

# grab the current revision number, if applicable
__PACKAGE__->cache->{svn_revision} = timeout 5, sub {
    open my $fh, '-|', 'svn', 'info'
        or return;
    while (my $line = <$fh>) {
        my ($revision) = ($line =~ /^ Revision: [ ] (\d+) $/smx);
        if ($revision) {
            return $revision;
        }
    }
    return;
};

{
    # WARNING: HERE BE DRAGONS, AND BY DRAGONS I MEAN HACKS
    no warnings 'redefine';

    # I find myself doing this a lot and it's a bit cumbersome
    *DBIx::Class::ResultSet::is_empty = sub {
        my ($self) = @_;
        my $first = $self->first;
        $self->reset;
        return not $first;
    };

    # DBIx::Class's find_or_create is incredibly stupid and allows for race
    # conditions with critical code like this.
    # CAVEAT EMPTOR: may break if you upgrade
    *DBIx::Class::ResultSet::find_or_create = sub {
        my $self     = shift;
        my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
        my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
        my $exists   = $self->find($hash, $attrs);
        # this bit is different
        return $exists if defined $exists;
        $exists = eval { $self->create($hash) };
        if ($@ and $@ =~ /Duplicate entry/) {
            return $self->find($hash, $attrs);
        } elsif ($@) {
            die $@;
        } else {
            return $exists;
        }
    };
}

=head1 METHODS

=head2 site_opts

Extremely lazy method for getting site options.  Seriously, seriously lazy.

=cut

sub site_opts {
    return shift->config->{site};
}

=head2 cache

Returns a cache hash for holding small bits of data useful between requests
but not worth a database table/row/hit.

=cut

my $cache;
sub cache {
    $cache ||= {};  # so we can call this function above
    return $cache;
}

=head2 uri

Shortcut for generating URIs.

    $c->uri( $controller, $action, @arguments )

=cut

sub uri {
    my ($self, $con, $sub, @args) = @_;

    my $url = $self->uri_for(
        $self->controller($con)->action_for($sub),
        @args
    );
    $url =~ tr/&/;/; # fuck ampersands

    return $url;
}

=head2 uri_for

Override of Catalyst's uri_for that clones parameters before passing them
along, so I don't have to worry about e.g. reusing the same query args hashref
several times in a template.

=cut

sub uri_for {
    my ($self, @etc) = @_;

    # Only the last parameter can be a query arg hashref
    if (@etc and ref $etc[-1] eq 'HASH') {
        $etc[-1] = dclone $etc[-1];
    }

    return $self->next::method(@etc);
}

=head2 vee_abort

Stops execution and reports error(s).  Only use this for errors caused by user
input that prevent a controller from executing normally, such as a thread that
doesn't exist; internal errors should use die().

If you pass an array of scalars, every EVEN one is assumed to be untrusted user
input that must be escaped.  This is so you can do the following:

    $c->vee_abort("There is no thingy with id ", $user_input, "!  Sorry.");

C<$user_input> is the second argument, so it will be run through C<vee_cleanse>
before being sent off to the browser.

If you want multiple errors, make each one an arrayref.

=cut

# BEGIN THE CLEANSING
sub _final_solution {
    my $self = shift;
    my @ret;

    if (ref $_[0] eq 'ARRAY') {
        @ret = @_;
    } else {
        @ret = [ @_ ];
    }

    for my $row (@ret) {
        for my $i (0 .. ($#$row - 1) / 2) {
            $row->[$i * 2 + 1] = $self->vee_cleanse( $row->[$i * 2 + 1] );
        }
        $row = join '', @$row;
    }

    return @ret;
}

sub vee_abort {
    my $self = shift;
    my $s = $self->stash;
    my @errors = $self->_final_solution(@_);

    $s->{template} = 'blank.tt';
    $s->{error_msg} = \@errors;
    $s->{page_title} = $s->{page_title} ? "Error: " . $s->{page_title} : "Error";
    $self->detach;
}

=head2 vee_stop

Stops execution and reports a message.  Use this when, for whatever reason, a
controller has nothing to do but hasn't actually encountered any problems:
e.g., a search with no results.

Arguments work the same way as with C<vee_abort>.

=cut

sub vee_stop {
    my $self = shift;
    my $s = $self->stash;
    my @msgs = $self->_final_solution(@_);

    $s->{template} = 'blank.tt';
    $s->{info_msg} = \@msgs;
    $s->{page_title} ||= "Message";
    $self->detach;
}

=head2 vee_cleanse

Format a string from some unknown source so it is suitable for inserting into
an XHTML document.  This consists of escaping special characters, converting
newlines to <br/>, and wrapping the result in <code> tags.

=cut

sub vee_cleanse {
    my $self = shift;
    my $text = shift || '';
    return '<code>' . Vee::Utils::cleanse($text) . '</code>';
}

=head1 SEE ALSO

L<Vee::Controller::Root>, L<Catalyst>

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