package BackPAN::Web;
use Web::Simple __PACKAGE__;
-use Plack::Request;
use Plack::Builder;
use Plack::Util;
use HTML::Zoom;
use HTML::Zoom::FilterBuilder::Template;
-use BackPAN::Index;
-use Data::Page;
-use Data::Page::FlickrLike;
use File::stat;
use DateTime;
-use Log::Log4perl 'get_logger';
-our $VERSION = '0.14';
-
-default_config(
- template_dir => 'root/html',
- backpan_url => 'http://backpan.perl.org/',
- cpan_search_url => 'http://search.cpan.org/',
-);
-
-sub _build_request_obj_from {
- my ( $self, $env ) = @_;
- return $self->request(Plack::Request->new($env));
-}
-
-sub request {
- my $self = shift;
- $self->{'request'} = shift if @_;
- return $self->{'request'};
-}
-
-sub req { return shift->request(@_) }
-
-sub log {
- my ( $self, $level, $msg ) = @_;
- chomp $msg;
- $self->request->{'env'}->{'psgix.logger'}->({
- level => $level,
- message => $msg,
- });
-}
-
-sub backpan_index {
- return $_[0]->{'backpan_index'} ||= BackPAN::Index->new({
- update => 0,
- debug => 0,
- releases_only_from_authors => 1,
- });
-}
+our $VERSION = '1.0';
sub slurp {
my ( $self, $filename ) = @_;
sub template_filename_for {
my ( $self, $name ) = @_;
- return $self->config->{'template_dir'} . "/${name}.html";
+ return "root/html/${name}.html";
}
sub layout_zoom {
], ref $body ? $body->to_fh : [ $body ] ];
}
-sub add_listing {
- my ( $self, $resultset, $row_data_cb ) = @_;
- my $req_base = $self->req->base;
- my $i = 1;
- return sub {
- $_->select('.main-list')
- ->repeat_content([
- map { my $row = $_;
- my ( $name, $label, $href ) = $self->$row_data_cb($row);
- sub {
- my $zoom = $_;
- $zoom = $zoom->select('li')->add_to_attribute(class => 'even')
- if $i++ % 2 == 0;
- if ( $href =~ m/http/i ) {
- $zoom = $zoom->select('a')->add_to_attribute(href => $href)
- ->then
- ->add_to_attribute(target => '_blank')
- ->then;
- }
- else {
- $zoom = $zoom->select('a')->add_to_attribute(
- href => $req_base . "${href}/${name}/"
- )->then;
- }
- $zoom->replace_content($label);
- }
- } ( ref $resultset eq 'ARRAY' ? @$resultset : $resultset->all )
- ]);
- };
-}
-
-sub add_paging_ordering {
- my ( $self, $pager, $ordering_options ) = @_;
- return sub {
- $_->apply($self->add_paging($pager))
- ->apply($self->add_ordering($ordering_options));
- };
-}
-
-sub add_paging {
- my ( $self, $pager ) = @_;
- my ( $curr_page, $curr_page_size )
- = ( $pager->current_page, $pager->entries_per_page );
- my $paging_uri = $self->req->uri;
- return sub {
- $_->select('#pages')
- ->repeat_content([
- map { my $page_number = $_;
- $page_number == 0 ?
- sub {
- $_->select('span')->replace_content('...');
- }
- : sub {
- $paging_uri->query_form({
- $paging_uri->query_form,
- page => $page_number,
- rows => $curr_page_size,
- });
- $_->select('a')->add_to_attribute(href => $paging_uri)
- ->then
- ->replace_content($page_number);
- }
- } $pager->navigations
- ])
- ->select('.paging-desc')
- ->replace_content(
- join(q{ }, 'Page', $curr_page, 'of', $pager->last_page) . q{.}
- )
- ->select('.entries')
- ->replace_content($pager->total_entries . ' entries.')
- ->select('.page-size-options')
- ->repeat_content([
- map {
- my $page_size = $_; sub {
- $paging_uri->query_form({
- $paging_uri->query_form,
- page => $curr_page,
- rows => $page_size,
- });
- $_->select('a')->add_to_attribute(href => $paging_uri)
- ->then
- ->replace_content($page_size);
- }
- } qw/10 20 30 50 100 200/
- ]);
- };
-}
-
-sub add_ordering {
- my ( $self, $options ) = @_;
- my $ordering_uri = $self->req->uri;
- return sub {
- $_->select('.ordering-options')
- ->repeat_content([
- map { my $order_by = $_; sub {
- $ordering_uri->query_form({
- $ordering_uri->query_form,
- order_by => $order_by,
- });
- my $order_by_label = join(q{ }, map ucfirst, split(/\_/, $order_by));
- $_->select('a')->add_to_attribute(href => $ordering_uri)
- ->then
- ->replace_content($order_by_label);
- }
- } @$options
- ]);
- };
-}
-
sub index_page_content {
my $self = shift;
- return $self->template_zoom_for('index')
- ->apply($self->add_listing(scalar $self->releases, sub {
- return ((map { $_[1]->$_ } qw/dist distvname/), 'distribution');
- }));
-}
-
-sub validate_paging_params {
- my ( $self, $args ) = @_;
- my ( $page, $rows ) = @$args{qw/page rows/};
- $page = 1 unless $page && $page =~ /^\d+$/;
- $rows = 25 unless $rows && $rows =~ /^\d+$/;
- return ( $page, $rows );
-}
-
-sub releases {
- my ( $self, $args ) = @_;
- my ( $order_by, $page, $rows )
- = ( $args->{'order_by'}, $self->validate_paging_params($args) );
- return $self->backpan_index->releases->search({}, {
- order_by => { -desc => 'date' },
- page => $page,
- rows => $rows,
+ 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 releases_page_content {
- my ( $self, $release_rs ) = @_;
- return $self->template_zoom_for('listing')
- ->apply($self->add_listing($release_rs, sub {
- return ((map { $_[1]->$_ } qw/dist distvname/), 'distribution');
- }))
- ->apply($self->add_paging($release_rs->pager));
-}
-
-sub dists {
- my ( $self, $args ) = @_;
- my ( $order_by, $page, $rows )
- = ( $args->{'order_by'}, $self->validate_paging_params($args) );
- return $self->backpan_index->dists->search({}, {
- order_by => 'name',
- page => $page,
- rows => $rows,
- });
-}
-
-sub get_dist { return shift->backpan_index->dist(@_) }
-
-sub format_dist_name { return join(q{::}, split /-/, $_[1] ) }
-
-sub dists_page_content {
- my ( $self, $dist_rs ) = @_;
- return $self->template_zoom_for('listing')
- ->apply($self->add_listing($dist_rs, sub {
- my $dist_name = $_[1]->name;
- return (
- $dist_name, $self->format_dist_name($dist_name), 'distribution'
- );
- }))
- ->apply($self->add_paging($dist_rs->pager));
-}
-
-sub dist_info_page_content {
- my ( $self, $dist, $query_params ) = @_;
- my ( $page, $rows ) = $self->validate_paging_params($query_params);
- my $release_rs = $dist->releases->search({}, {
- order_by => { -desc => 'date' },
- page => $page,
- rows => $rows,
- });
- my ( $f_release, $l_release )
- = ( $dist->first_release, $dist->latest_release );
- my @maints = $dist->authors;
- my $config = $self->config;
- my ( $backpan_url, $cpan_search_url )
- = ( $config->{'backpan_url'}, $config->{'cpan_search_url'} );
- return $self->template_zoom_for('dist')
- ->select('#dist')->template_text_raw({
- name => $self->format_dist_name($dist->name),
- num_releases => $dist->num_releases,
- f_release_label => $f_release->distvname,
- l_release_label => $l_release->distvname,
- })
- ->select('.f_rel_link')->add_to_attribute(
- href => $backpan_url . $f_release->path->path,
- )
- ->select('.l_rel_link')->add_to_attribute(
- href => $backpan_url . $l_release->path->path,
- )
- ->select('.maintainer-list')->repeat_content([
- map { my $cpanid = $_; sub {
- $_->select('a')->add_to_attribute(
- href => $cpan_search_url . lc "~${cpanid}"
- )->then
- ->add_to_attribute(target => '_blank')
- ->then
- ->replace_content($cpanid);
- }
- } @maints
- ])
- ->apply($self->add_listing($release_rs, sub {
- my $release = $_;
- return (
- $release->distvname,
- join(q{ | }, $release->distvname,
- DateTime->from_epoch({ epoch => $release->date })
- ->strftime('%b %d, %Y - %T')),
- $backpan_url . $release->path->path,
- );
- }))
- ->apply($self->add_paging($release_rs->pager));
-}
-
-sub authors {
- my ( $self, $args ) = @_;
- my ( $page, $rows ) = $self->validate_paging_params($args);
- my @authors = $self->backpan_index->releases->search({}, {
- group_by => 'cpanid',
- order_by => 'cpanid',
- })->get_column('cpanid')->all;
- my $pager = Data::Page->new;
- $pager->total_entries(scalar @authors);
- $pager->entries_per_page($rows);
- if ( $page > $pager->last_page ) {
- return undef;
- }
- else {
- $pager->current_page($page);
- return {
- list => [ splice @authors, ($page-1) * $rows, $rows ],
- pager => $pager,
- };
- }
-}
-
-sub authors_page_content {
- my ( $self, $authors ) = @_;
- return $self->template_zoom_for('listing')
- ->apply($self->add_listing($authors->{'list'}, sub {
- my $cpanid = $_[1];
- return (
- $cpanid, $cpanid,
- $self->config->{'cpan_search_url'} . lc "~${cpanid}"
- );
- }))
- ->apply($self->add_paging($authors->{'pager'}));
-}
-
-sub _mangle_query_string {
- my ( $self, $q ) = @_;
- $q =~ s{\s+|::|\+}{-}g;
- $q =~ s{-$}{};
- return $q =~ s{\*}{}g ? "$q%" : "%$q%";
-}
-
-sub search {
- my ( $self, $q, $query_params ) = @_;
- my $query_str = lc $self->_mangle_query_string($q);
- return $self->dists($query_params)->search({
- -or => [
- { 'LOWER(me.name)' => { -like => $query_str } },
- { 'LOWER(me.first_author)' => { -like => $query_str } },
- { 'LOWER(me.latest_author)' => { -like => $query_str } },
- ],
- });
-}
-
-dispatch {
- subdispatch sub () {
- $self->_build_request_obj_from($_[+PSGI_ENV]);
- my $base_title = 'BackPAN.org';
- [
- sub (/) {
- $self->html_response({ body => $self->index_page_content });
- },
-
- sub ( /about|/about/ ) {
- my $about_filename = $self->template_filename_for('about');
- my $about_st = stat($about_filename)
- or $self->log(error_die => "No $about_filename: $!");
- $self->html_response({
- header => {
- 'Last-Modified' => $about_st->mtime,
- },
- body => $self->slurp($about_filename),
- });
- },
-
- sub ( /releases|/releases/ + ?* ) {
- my $release_rs = $self->releases($_[1]);
- if ( $release_rs->count ) {
- my $body = $self->releases_page_content($release_rs)
- ->select('#nav-releases')->add_to_attribute(class => 'active')
- ->select('title')->replace_content(join q{ - }, 'Releases', $base_title);
- return $self->html_response({ body => $body });
- }
- else {
- return $self->html_response({
- status_code => 404,
- body => $self->error_404,
- });
- }
- },
-
- sub ( /dists|/dists/ + ?* ) {
- my $dist_rs = $self->dists($_[1]);
- if ( $dist_rs->count ) {
- my $body = $self->dists_page_content($dist_rs)
- ->select('#nav-dists')->add_to_attribute(class => 'active')
- ->select('title')->replace_content(join q{ - }, 'Distributions', $base_title);
- return $self->html_response({ body => $body });
- }
- else {
- return $self->html_response({
- status_code => 404,
- body => $self->error_404,
- });
- }
- },
-
- sub ( /distribution/*|/distribution/*/ + ?* ) {
- if ( my $dist = $self->get_dist($_[1]) ) {
- my $body = $self->dist_info_page_content($dist, $_[2])
- ->select('title')->replace_content(join q{ - }, $self->format_dist_name($dist->name), $base_title);
- return $self->html_response({ body => $body });
- }
- else {
- return $self->html_response({
- status_code => 404,
- body => $self->error_404,
- });
- }
- },
-
- sub ( /authors|/authors/ + ?* ) {
- if ( my $authors = $self->authors($_[1]) ) {
- my $body = $self->authors_page_content($authors)
- ->select('#nav-authors')->add_to_attribute(class => 'active')
- ->select('title')->replace_content(join q{ - }, 'Authors', $base_title);
- return $self->html_response({ body => $body });
- }
- else {
- return $self->html_response({
- status_code => 404,
- body => $self->error_404,
- });
- }
- },
-
- sub ( /search|/search/ + ?q=&* ) {
- my ( $self, $query_str, $query_params ) = @_;
- my $dist_rs = $self->search($query_str, $query_params);
- if ( $dist_rs->count ) {
- my $body = $self->dists_page_content($dist_rs)
- ->select('#q')->add_to_attribute(
- value => $query_str
- )
- ->select('title')->replace_content(join q{ - }, 'Search', $base_title);
- return $self->html_response({ body => $body });
- }
- else {
- return $self->html_response({
- status_code => 404,
- body => $self->error_404,
- });
- }
- },
- ],
- },
+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;
+ },
+ );
};
-sub as_psgi_app {
- my $class = shift;
- my $app = $class->SUPER::as_psgi_app;
+around to_psgi_app => sub {
+ my ($orig, $self) = (shift, shift);
+ my $app = $self->$orig(@_);
return builder {
- enable_if { $ENV{PLACK_ENV} ne 'deployment' }
- sub {
- my $mw_prefix = 'Plack::Middleware';
- my $mw_class = Plack::Util::load_class('Static', $mw_prefix);
- $app = $mw_class->wrap($app,
- path => qr{^/static},
- root => './root/',
- );
- $mw_class = Plack::Util::load_class('Debug', $mw_prefix);
- $app = $mw_class->wrap($app,
- panels => [qw(DBITrace Memory Timer Environment Response)],
- );
- $app;
- };
+ 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/error_404.html';
- enable 'HTTPExceptions';
+ 404 => 'root/html/index.html';
+ enable 'HTTPExceptions';
enable 'Head';
- #enable 'AccessLog',
- # format => 'combined',
- # logger => sub { get_logger('accesslog')->info(@_) };
- #enable 'Log4perl', conf => 'log/log.conf';
$app;
};
-}
+};
=head1 AUTHOR
projects / catagits/BackPAN-Web.git / commitdiff
