3 use Web::Simple __PACKAGE__;
8 use HTML::Zoom::FilterBuilder::Template;
11 use Data::Page::FlickrLike;
14 use Log::Log4perl 'get_logger';
16 our $VERSION = '0.14';
19 template_dir => 'root/html',
20 backpan_url => 'http://backpan.perl.org/',
21 cpan_search_url => 'http://search.cpan.org/',
24 sub _build_request_obj_from {
25 my ( $self, $env ) = @_;
26 return $self->request(Plack::Request->new($env));
31 $self->{'request'} = shift if @_;
32 return $self->{'request'};
35 sub req { return shift->request(@_) }
38 my ( $self, $level, $msg ) = @_;
40 $self->request->{'env'}->{'psgix.logger'}->({
47 return $_[0]->{'backpan_index'} ||= BackPAN::Index->new({
50 releases_only_from_authors => 1,
55 my ( $self, $filename ) = @_;
56 return do { local (@ARGV, $/) = $filename; <> };
59 sub template_filename_for {
60 my ( $self, $name ) = @_;
61 return $self->config->{'template_dir'} . "/${name}.html";
66 return $self->{'template_zoom_for_template'}{'layout'} ||= HTML::Zoom->from_file(
67 $self->template_filename_for('layout')
71 sub template_zoom_for {
72 my ( $self, $template_name ) = @_;
73 $self->{'template_zoom_for_template'}{$template_name} ||= do {
75 HTML::Zoom->from_file(
76 $self->template_filename_for($template_name)
77 )->select('#content')->collect_content({ into => \@body })->run;
79 ->select('#content')->replace_content(\@body)
86 return $self->slurp( $self->template_filename_for('error_404') );
90 my ( $self, $args ) = @_;
91 my ( $status, $header, $body ) = @$args{qw/status_code header body/};
92 return [ $status || 200, [
93 $header ? ( %$header ) : (),
94 'Content-type' => 'text/html',
95 ], ref $body ? $body->to_fh : [ $body ] ];
99 my ( $self, $resultset, $row_data_cb ) = @_;
100 my $req_base = $self->req->base;
103 $_->select('.main-list')
106 my ( $name, $label, $href ) = $self->$row_data_cb($row);
109 $zoom = $zoom->select('li')->add_to_attribute(class => 'even')
111 if ( $href =~ m/http/i ) {
112 $zoom = $zoom->select('a')->add_to_attribute(href => $href)
114 ->add_to_attribute(target => '_blank')
118 $zoom = $zoom->select('a')->add_to_attribute(
119 href => $req_base . "${href}/${name}/"
122 $zoom->replace_content($label);
124 } ( ref $resultset eq 'ARRAY' ? @$resultset : $resultset->all )
129 sub add_paging_ordering {
130 my ( $self, $pager, $ordering_options ) = @_;
132 $_->apply($self->add_paging($pager))
133 ->apply($self->add_ordering($ordering_options));
138 my ( $self, $pager ) = @_;
139 my ( $curr_page, $curr_page_size )
140 = ( $pager->current_page, $pager->entries_per_page );
141 my $paging_uri = $self->req->uri;
145 map { my $page_number = $_;
148 $_->select('span')->replace_content('...');
151 $paging_uri->query_form({
152 $paging_uri->query_form,
153 page => $page_number,
154 rows => $curr_page_size,
156 $_->select('a')->add_to_attribute(href => $paging_uri)
158 ->replace_content($page_number);
160 } $pager->navigations
162 ->select('.paging-desc')
164 join(q{ }, 'Page', $curr_page, 'of', $pager->last_page) . q{.}
167 ->replace_content($pager->total_entries . ' entries.')
168 ->select('.page-size-options')
171 my $page_size = $_; sub {
172 $paging_uri->query_form({
173 $paging_uri->query_form,
177 $_->select('a')->add_to_attribute(href => $paging_uri)
179 ->replace_content($page_size);
181 } qw/10 20 30 50 100 200/
187 my ( $self, $options ) = @_;
188 my $ordering_uri = $self->req->uri;
190 $_->select('.ordering-options')
192 map { my $order_by = $_; sub {
193 $ordering_uri->query_form({
194 $ordering_uri->query_form,
195 order_by => $order_by,
197 my $order_by_label = join(q{ }, map ucfirst, split(/\_/, $order_by));
198 $_->select('a')->add_to_attribute(href => $ordering_uri)
200 ->replace_content($order_by_label);
207 sub index_page_content {
209 return $self->template_zoom_for('index')
210 ->apply($self->add_listing(scalar $self->releases, sub {
211 return ((map { $_[1]->$_ } qw/dist distvname/), 'distribution');
215 sub validate_paging_params {
216 my ( $self, $args ) = @_;
217 my ( $page, $rows ) = @$args{qw/page rows/};
218 $page = 1 unless $page && $page =~ /^\d+$/;
219 $rows = 25 unless $rows && $rows =~ /^\d+$/;
220 return ( $page, $rows );
224 my ( $self, $args ) = @_;
225 my ( $order_by, $page, $rows )
226 = ( $args->{'order_by'}, $self->validate_paging_params($args) );
227 return $self->backpan_index->releases->search({}, {
228 order_by => { -desc => 'date' },
234 sub releases_page_content {
235 my ( $self, $release_rs ) = @_;
236 return $self->template_zoom_for('listing')
237 ->apply($self->add_listing($release_rs, sub {
238 return ((map { $_[1]->$_ } qw/dist distvname/), 'distribution');
240 ->apply($self->add_paging($release_rs->pager));
244 my ( $self, $args ) = @_;
245 my ( $order_by, $page, $rows )
246 = ( $args->{'order_by'}, $self->validate_paging_params($args) );
247 return $self->backpan_index->dists->search({}, {
254 sub get_dist { return shift->backpan_index->dist(@_) }
256 sub format_dist_name { return join(q{::}, split /-/, $_[1] ) }
258 sub dists_page_content {
259 my ( $self, $dist_rs ) = @_;
260 return $self->template_zoom_for('listing')
261 ->apply($self->add_listing($dist_rs, sub {
262 my $dist_name = $_[1]->name;
264 $dist_name, $self->format_dist_name($dist_name), 'distribution'
267 ->apply($self->add_paging($dist_rs->pager));
270 sub dist_info_page_content {
271 my ( $self, $dist, $query_params ) = @_;
272 my ( $page, $rows ) = $self->validate_paging_params($query_params);
273 my $release_rs = $dist->releases->search({}, {
274 order_by => { -desc => 'date' },
278 my ( $f_release, $l_release )
279 = ( $dist->first_release, $dist->latest_release );
280 my @maints = $dist->authors;
281 my $config = $self->config;
282 my ( $backpan_url, $cpan_search_url )
283 = ( $config->{'backpan_url'}, $config->{'cpan_search_url'} );
284 return $self->template_zoom_for('dist')
285 ->select('#dist')->template_text_raw({
286 name => $self->format_dist_name($dist->name),
287 num_releases => $dist->num_releases,
288 f_release_label => $f_release->distvname,
289 l_release_label => $l_release->distvname,
291 ->select('.f_rel_link')->add_to_attribute(
292 href => $backpan_url . $f_release->path->path,
294 ->select('.l_rel_link')->add_to_attribute(
295 href => $backpan_url . $l_release->path->path,
297 ->select('.maintainer-list')->repeat_content([
298 map { my $cpanid = $_; sub {
299 $_->select('a')->add_to_attribute(
300 href => $cpan_search_url . lc "~${cpanid}"
302 ->add_to_attribute(target => '_blank')
304 ->replace_content($cpanid);
308 ->apply($self->add_listing($release_rs, sub {
312 join(q{ | }, $release->distvname,
313 DateTime->from_epoch({ epoch => $release->date })
314 ->strftime('%b %d, %Y - %T')),
315 $backpan_url . $release->path->path,
318 ->apply($self->add_paging($release_rs->pager));
322 my ( $self, $args ) = @_;
323 my ( $page, $rows ) = $self->validate_paging_params($args);
324 my @authors = $self->backpan_index->releases->search({}, {
325 group_by => 'cpanid',
326 order_by => 'cpanid',
327 })->get_column('cpanid')->all;
328 my $pager = Data::Page->new;
329 $pager->total_entries(scalar @authors);
330 $pager->entries_per_page($rows);
331 if ( $page > $pager->last_page ) {
335 $pager->current_page($page);
337 list => [ splice @authors, ($page-1) * $rows, $rows ],
343 sub authors_page_content {
344 my ( $self, $authors ) = @_;
345 return $self->template_zoom_for('listing')
346 ->apply($self->add_listing($authors->{'list'}, sub {
350 $self->config->{'cpan_search_url'} . lc "~${cpanid}"
353 ->apply($self->add_paging($authors->{'pager'}));
356 sub _mangle_query_string {
357 my ( $self, $q ) = @_;
358 $q =~ s{\s+|::|\+}{-}g;
360 return $q =~ s{\*}{}g ? "$q%" : "%$q%";
364 my ( $self, $q, $query_params ) = @_;
365 my $query_str = lc $self->_mangle_query_string($q);
366 return $self->dists($query_params)->search({
368 { 'LOWER(me.name)' => { -like => $query_str } },
369 { 'LOWER(me.first_author)' => { -like => $query_str } },
370 { 'LOWER(me.latest_author)' => { -like => $query_str } },
377 $self->_build_request_obj_from($_[+PSGI_ENV]);
378 my $base_title = 'BackPAN.org';
381 $self->html_response({ body => $self->index_page_content });
384 sub ( /about|/about/ ) {
385 my $about_filename = $self->template_filename_for('about');
386 my $about_st = stat($about_filename)
387 or $self->log(error_die => "No $about_filename: $!");
388 $self->html_response({
390 'Last-Modified' => $about_st->mtime,
392 body => $self->slurp($about_filename),
396 sub ( /releases|/releases/ + ?* ) {
397 my $release_rs = $self->releases($_[1]);
398 if ( $release_rs->count ) {
399 my $body = $self->releases_page_content($release_rs)
400 ->select('#nav-releases')->add_to_attribute(class => 'active')
401 ->select('title')->replace_content(join q{ - }, 'Releases', $base_title);
402 return $self->html_response({ body => $body });
405 return $self->html_response({
407 body => $self->error_404,
412 sub ( /dists|/dists/ + ?* ) {
413 my $dist_rs = $self->dists($_[1]);
414 if ( $dist_rs->count ) {
415 my $body = $self->dists_page_content($dist_rs)
416 ->select('#nav-dists')->add_to_attribute(class => 'active')
417 ->select('title')->replace_content(join q{ - }, 'Distributions', $base_title);
418 return $self->html_response({ body => $body });
421 return $self->html_response({
423 body => $self->error_404,
428 sub ( /distribution/*|/distribution/*/ + ?* ) {
429 if ( my $dist = $self->get_dist($_[1]) ) {
430 my $body = $self->dist_info_page_content($dist, $_[2])
431 ->select('title')->replace_content(join q{ - }, $self->format_dist_name($dist->name), $base_title);
432 return $self->html_response({ body => $body });
435 return $self->html_response({
437 body => $self->error_404,
442 sub ( /authors|/authors/ + ?* ) {
443 if ( my $authors = $self->authors($_[1]) ) {
444 my $body = $self->authors_page_content($authors)
445 ->select('#nav-authors')->add_to_attribute(class => 'active')
446 ->select('title')->replace_content(join q{ - }, 'Authors', $base_title);
447 return $self->html_response({ body => $body });
450 return $self->html_response({
452 body => $self->error_404,
457 sub ( /search|/search/ + ?q=&* ) {
458 my ( $self, $query_str, $query_params ) = @_;
459 my $dist_rs = $self->search($query_str, $query_params);
460 if ( $dist_rs->count ) {
461 my $body = $self->dists_page_content($dist_rs)
462 ->select('#q')->add_to_attribute(
465 ->select('title')->replace_content(join q{ - }, 'Search', $base_title);
466 return $self->html_response({ body => $body });
469 return $self->html_response({
471 body => $self->error_404,
481 my $app = $class->SUPER::as_psgi_app;
483 enable_if { $ENV{PLACK_ENV} ne 'deployment' }
485 my $mw_prefix = 'Plack::Middleware';
486 my $mw_class = Plack::Util::load_class('Static', $mw_prefix);
487 $app = $mw_class->wrap($app,
488 path => qr{^/static},
491 $mw_class = Plack::Util::load_class('Debug', $mw_prefix);
492 $app = $mw_class->wrap($app,
493 panels => [qw(DBITrace Memory Timer Environment Response)],
497 enable 'ContentLength';
498 enable 'ConditionalGET';
499 enable 'ErrorDocument',
500 500 => 'root/html/error_500.html',
501 404 => 'root/html/error_404.html';
502 enable 'HTTPExceptions';
505 # format => 'combined',
506 # logger => sub { get_logger('accesslog')->info(@_) };
507 #enable 'Log4perl', conf => 'log/log.conf';
514 Wallace Reis, C<< <wreis at cpan.org> >>
516 =head1 LICENSE AND COPYRIGHT
518 © Copyright 2010-2011 Wallace Reis.
522 __PACKAGE__->run_if_script;