Merge branch 'hotfix_myinfo'

[catagits/BackPAN-Web.git] / lib / BackPAN / Web.pm

package BackPAN::Web;

use Web::Simple __PACKAGE__;
use Plack::Builder;
use Plack::Util;
use HTML::Zoom;
use HTML::Zoom::FilterBuilder::Template;
use File::stat;
use DateTime;

our $VERSION = '1.0';

sub slurp {
    my ( $self, $filename ) = @_;
    return do { local (@ARGV, $/) = $filename; <> };
}

sub template_filename_for {
    my ( $self, $name ) = @_;
    return "root/html/${name}.html";
}

sub layout_zoom {
    my $self = shift;
    return $self->{'template_zoom_for_template'}{'layout'} ||= HTML::Zoom->from_file(
        $self->template_filename_for('layout')
    );
}

sub template_zoom_for {
    my ( $self, $template_name ) = @_;
    $self->{'template_zoom_for_template'}{$template_name} ||= do {
        my @body;
        HTML::Zoom->from_file(
            $self->template_filename_for($template_name)
        )->select('#content')->collect_content({ into => \@body })->run;
        $self->layout_zoom
        ->select('#content')->replace_content(\@body)
        ->memoize;
    };
}

sub error_404 {
    my $self = shift;
    return $self->slurp( $self->template_filename_for('error_404') );
}

sub html_response {
    my ( $self, $args ) = @_;
    my ( $status, $header, $body ) = @$args{qw/status_code header body/};
    return [ $status || 200, [
        $header ? ( %$header ) : (),
        'Content-type' => 'text/html',
    ], ref $body ? $body->to_fh : [ $body ] ];
}

sub index_page_content {
    my $self = shift;
    my $index_filename = $self->template_filename_for('index');
    my $index_st = stat($index_filename)
        or die "No $index_filename: $!";
    $self->html_response({
        header => { 'Last-Modified' => $index_st->mtime },
        body => $self->slurp($index_filename),
    });
}

sub dispatch_request {
    my $self = shift;
       (
          sub (/) {
              $self->index_page_content;
          },

	  sub ( /about|/about/ ) {
              my $about_filename = $self->template_filename_for('about');
              my $about_st = stat($about_filename)
                  or die "No $about_filename: $!";
              $self->html_response({
                  header => {
                      'Last-Modified' => $about_st->mtime,
                  },
                  body => $self->slurp($about_filename),
              });
          },

	  sub ( /releases|/releases/ + ?* ) {
              $self->index_page_content;
          },

          sub ( /dists|/dists/ + ?* ) {
              $self->index_page_content;
          },

          sub ( /distribution/*|/distribution/*/ + ?* ) {
              $self->index_page_content;
          },

          sub ( /authors|/authors/ + ?* ) {
              $self->index_page_content;
	  },

          sub ( /search|/search/ + ?q=&* ) {
              $self->index_page_content;
	  },
     );
};

around to_psgi_app => sub {
    my ($orig, $self) = (shift, shift);
    my $app = $self->$orig(@_);
    return builder {
        enable_if { $ENV{PLACK_ENV} ne 'deployment' } 'Static',
            path => qr{^/static},
            root => './root/';
        enable 'ContentLength';
        enable 'ConditionalGET';
        enable 'ErrorDocument',
            500 => 'root/html/error_500.html',
	    404 => 'root/html/index.html';
	enable 'HTTPExceptions';
        enable 'Head';
        $app;
    };
};

=head1 AUTHOR

Wallace Reis, C<< <wreis at cpan.org> >>

=head1 LICENSE AND COPYRIGHT

© Copyright 2010-2011 Wallace Reis.

=cut

__PACKAGE__->run_if_script;