From: wreis Date: Mon, 13 Jun 2011 18:36:11 +0000 (-0300) Subject: DEPRECATE in favor of metacpan.org X-Git-Tag: 1.0^2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FBackPAN-Web.git;a=commitdiff_plain;h=92111caaae20beedbdbf0592f1fe7d2c947c2ba7 DEPRECATE in favor of metacpan.org --- diff --git a/lib/BackPAN/Web.pm b/lib/BackPAN/Web.pm index f60bf02..44e6dc8 100644 --- a/lib/BackPAN/Web.pm +++ b/lib/BackPAN/Web.pm @@ -1,55 +1,14 @@ 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 ) = @_; @@ -58,7 +17,7 @@ sub slurp { sub template_filename_for { my ( $self, $name ) = @_; - return $self->config->{'template_dir'} . "/${name}.html"; + return "root/html/${name}.html"; } sub layout_zoom { @@ -95,419 +54,75 @@ sub html_response { ], 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 diff --git a/root/html/about.html b/root/html/about.html index b72e25a..27a4a31 100644 --- a/root/html/about.html +++ b/root/html/about.html @@ -22,7 +22,7 @@