lib/BackPAN/Web.pm

   1 package BackPAN::Web;
   2
   3 use Web::Simple __PACKAGE__;
   4 use Plack::Builder;
   5 use Plack::Util;
   6 use HTML::Zoom;
   7 use HTML::Zoom::FilterBuilder::Template;
   8 use File::stat;
   9 use DateTime;
  10
  11 our $VERSION = '1.0';
  12
  13 sub slurp {
  14     my ( $self, $filename ) = @_;
  15     return do { local (@ARGV, $/) = $filename; <> };
  16 }
  17
  18 sub template_filename_for {
  19     my ( $self, $name ) = @_;
  20     return "root/html/${name}.html";
  21 }
  22
  23 sub layout_zoom {
  24     my $self = shift;
  25     return $self->{'template_zoom_for_template'}{'layout'} ||= HTML::Zoom->from_file(
  26         $self->template_filename_for('layout')
  27     );
  28 }
  29
  30 sub template_zoom_for {
  31     my ( $self, $template_name ) = @_;
  32     $self->{'template_zoom_for_template'}{$template_name} ||= do {
  33         my @body;
  34         HTML::Zoom->from_file(
  35             $self->template_filename_for($template_name)
  36         )->select('#content')->collect_content({ into => \@body })->run;
  37         $self->layout_zoom
  38         ->select('#content')->replace_content(\@body)
  39         ->memoize;
  40     };
  41 }
  42
  43 sub error_404 {
  44     my $self = shift;
  45     return $self->slurp( $self->template_filename_for('error_404') );
  46 }
  47
  48 sub html_response {
  49     my ( $self, $args ) = @_;
  50     my ( $status, $header, $body ) = @$args{qw/status_code header body/};
  51     return [ $status || 200, [
  52         $header ? ( %$header ) : (),
  53         'Content-type' => 'text/html',
  54     ], ref $body ? $body->to_fh : [ $body ] ];
  55 }
  56
  57 sub index_page_content {
  58     my $self = shift;
  59     my $index_filename = $self->template_filename_for('index');
  60     my $index_st = stat($index_filename)
  61         or die "No $index_filename: $!";
  62     $self->html_response({
  63         header => { 'Last-Modified' => $index_st->mtime },
  64         body => $self->slurp($index_filename),
  65     });
  66 }
  67
  68 sub dispatch_request {
  69     my $self = shift;
  70        (
  71           sub (/) {
  72               $self->index_page_content;
  73           },
  74
  75           sub ( /about|/about/ ) {
  76               my $about_filename = $self->template_filename_for('about');
  77               my $about_st = stat($about_filename)
  78                   or die "No $about_filename: $!";
  79               $self->html_response({
  80                   header => {
  81                       'Last-Modified' => $about_st->mtime,
  82                   },
  83                   body => $self->slurp($about_filename),
  84               });
  85           },
  86
  87           sub ( /releases|/releases/ + ?* ) {
  88               $self->index_page_content;
  89           },
  90
  91           sub ( /dists|/dists/ + ?* ) {
  92               $self->index_page_content;
  93           },
  94
  95           sub ( /distribution/*|/distribution/*/ + ?* ) {
  96               $self->index_page_content;
  97           },
  98
  99           sub ( /authors|/authors/ + ?* ) {
 100               $self->index_page_content;
 101           },
 102
 103           sub ( /search|/search/ + ?q=&* ) {
 104               $self->index_page_content;
 105           },
 106      );
 107 };
 108
 109 around to_psgi_app => sub {
 110     my ($orig, $self) = (shift, shift);
 111     my $app = $self->$orig(@_);
 112     return builder {
 113         enable_if { $ENV{PLACK_ENV} ne 'deployment' } 'Static',
 114             path => qr{^/static},
 115             root => './root/';
 116         enable 'ContentLength';
 117         enable 'ConditionalGET';
 118         enable 'ErrorDocument',
 119             500 => 'root/html/error_500.html',
 120             404 => 'root/html/index.html';
 121         enable 'HTTPExceptions';
 122         enable 'Head';
 123         $app;
 124     };
 125 };
 126
 127 =head1 AUTHOR
 128
 129 Wallace Reis, C<< <wreis at cpan.org> >>
 130
 131 =head1 LICENSE AND COPYRIGHT
 132
 133 © Copyright 2010-2011 Wallace Reis.
 134
 135 =cut
 136
 137 __PACKAGE__->run_if_script;