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

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,
    });
}

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

sub template_filename_for {
    my ( $self, $name ) = @_;
    return $self->config->{'template_dir'} . "/${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 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,
    });
}

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 as_psgi_app {
    my $class = shift;
    my $app = $class->SUPER::as_psgi_app;
    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 'ContentLength';
        enable 'ConditionalGET';
        enable 'ErrorDocument',
            500 => 'root/html/error_500.html',
            404 => 'root/html/error_404.html';
        enable 'HTTPExceptions';
        enable 'Head';
        #enable 'AccessLog',
        #    format => 'combined',
        #    logger => sub { get_logger('accesslog')->info(@_) };
        #enable 'Log4perl', conf => 'log/log.conf';
        $app;
    };
}

=head1 AUTHOR

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

=head1 LICENSE AND COPYRIGHT

© Copyright 2010-2011 Wallace Reis.

=cut

__PACKAGE__->run_if_script;
Commit	Line	Data
b67ffc2e	1	package BackPAN::Web;
	2
	3	use Web::Simple __PACKAGE__;
	4	use Plack::Request;
	5	use Plack::Builder;
	6	use Plack::Util;
	7	use HTML::Zoom;
	8	use HTML::Zoom::FilterBuilder::Template;
	9	use BackPAN::Index;
	10	use Data::Page;
	11	use Data::Page::FlickrLike;
	12	use File::stat;
	13	use DateTime;
	14	use Log::Log4perl 'get_logger';
	15
e819827c	16	our $VERSION = '0.14';
b67ffc2e	17
	18	default_config(
	19	template_dir => 'root/html',
	20	backpan_url => 'http://backpan.perl.org/',
	21	cpan_search_url => 'http://search.cpan.org/',
	22	);
	23
	24	sub _build_request_obj_from {
	25	my ( $self, $env ) = @_;
	26	return $self->request(Plack::Request->new($env));
	27	}
	28
	29	sub request {
	30	my $self = shift;
	31	$self->{'request'} = shift if @_;
	32	return $self->{'request'};
	33	}
	34
	35	sub req { return shift->request(@_) }
	36
	37	sub log {
	38	my ( $self, $level, $msg ) = @_;
	39	chomp $msg;
	40	$self->request->{'env'}->{'psgix.logger'}->({
	41	level => $level,
	42	message => $msg,
	43	});
	44	}
	45
	46	sub backpan_index {
	47	return $_[0]->{'backpan_index'} \|\|= BackPAN::Index->new({
	48	update => 0,
	49	debug => 0,
b67ffc2e	50	releases_only_from_authors => 1,
	51	});
	52	}
	53
	54	sub slurp {
	55	my ( $self, $filename ) = @_;
	56	return do { local (@ARGV, $/) = $filename; <> };
	57	}
	58
	59	sub template_filename_for {
	60	my ( $self, $name ) = @_;
	61	return $self->config->{'template_dir'} . "/${name}.html";
	62	}
	63
	64	sub layout_zoom {
	65	my $self = shift;
	66	return $self->{'template_zoom_for_template'}{'layout'} \|\|= HTML::Zoom->from_file(
	67	$self->template_filename_for('layout')
	68	);
	69	}
	70
	71	sub template_zoom_for {
	72	my ( $self, $template_name ) = @_;
	73	$self->{'template_zoom_for_template'}{$template_name} \|\|= do {
	74	my @body;
	75	HTML::Zoom->from_file(
	76	$self->template_filename_for($template_name)
	77	)->select('#content')->collect_content({ into => \@body })->run;
	78	$self->layout_zoom
	79	->select('#content')->replace_content(\@body)
	80	->memoize;
	81	};
	82	}
	83
	84	sub error_404 {
	85	my $self = shift;
	86	return $self->slurp( $self->template_filename_for('error_404') );
	87	}
	88
	89	sub html_response {
	90	my ( $self, $args ) = @_;
2a30b3c1	91	my ( $status, $header, $body ) = @$args{qw/status_code header body/};
2a30b3c1	92	return [ $status \|\| 200, [
b67ffc2e	93	$header ? ( %$header ) : (),
	94	'Content-type' => 'text/html',
	95	], ref $body ? $body->to_fh : [ $body ] ];
	96	}
	97
	98	sub add_listing {
	99	my ( $self, $resultset, $row_data_cb ) = @_;
	100	my $req_base = $self->req->base;
	101	my $i = 1;
	102	return sub {
	103	$_->select('.main-list')
	104	->repeat_content([
	105	map { my $row = $_;
	106	my ( $name, $label, $href ) = $self->$row_data_cb($row);
	107	sub {
	108	my $zoom = $_;
	109	$zoom = $zoom->select('li')->add_to_attribute(class => 'even')
	110	if $i++ % 2 == 0;
	111	if ( $href =~ m/http/i ) {
	112	$zoom = $zoom->select('a')->add_to_attribute(href => $href)
	113	->then
	114	->add_to_attribute(target => '_blank')
	115	->then;
	116	}
	117	else {
	118	$zoom = $zoom->select('a')->add_to_attribute(
	119	href => $req_base . "${href}/${name}/"
	120	)->then;
	121	}
	122	$zoom->replace_content($label);
	123	}
	124	} ( ref $resultset eq 'ARRAY' ? @$resultset : $resultset->all )
	125	]);
	126	};
	127	}
	128
	129	sub add_paging_ordering {
	130	my ( $self, $pager, $ordering_options ) = @_;
	131	return sub {
	132	$_->apply($self->add_paging($pager))
	133	->apply($self->add_ordering($ordering_options));
	134	};
	135	}
	136
	137	sub add_paging {
	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;
	142	return sub {
	143	$_->select('#pages')
	144	->repeat_content([
	145	map { my $page_number = $_;
	146	$page_number == 0 ?
	147	sub {
	148	$_->select('span')->replace_content('...');
	149	}
	150	: sub {
	151	$paging_uri->query_form({
	152	$paging_uri->query_form,
	153	page => $page_number,
	154	rows => $curr_page_size,
	155	});
	156	$_->select('a')->add_to_attribute(href => $paging_uri)
157	->then
158	->replace_content($page_number);
159	}
160	} $pager->navigations
161	])
162	->select('.paging-desc')
163	->replace_content(
164	join(q{ }, 'Page', $curr_page, 'of', $pager->last_page) . q{.}
165	)
166	->select('.entries')
167	->replace_content($pager->total_entries . ' entries.')
168	->select('.page-size-options')
169	->repeat_content([
170	map {
171	my $page_size = $_; sub {
172	$paging_uri->query_form({
173	$paging_uri->query_form,
174	page => $curr_page,
175	rows => $page_size,
176	});
177	$_->select('a')->add_to_attribute(href => $paging_uri)
178	->then
179	->replace_content($page_size);
180	}
181	} qw/10 20 30 50 100 200/
182	]);
183	};
184	}
185
186	sub add_ordering {
187	my ( $self, $options ) = @_;
188	my $ordering_uri = $self->req->uri;
189	return sub {
190	$_->select('.ordering-options')
191	->repeat_content([
192	map { my $order_by = $_; sub {
193	$ordering_uri->query_form({
194	$ordering_uri->query_form,
195	order_by => $order_by,
196	});
197	my $order_by_label = join(q{ }, map ucfirst, split(/\_/, $order_by));
198	$_->select('a')->add_to_attribute(href => $ordering_uri)
199	->then
200	->replace_content($order_by_label);
201	}
202	} @$options
203	]);
204	};
205	}
206
207	sub index_page_content {
208	my $self = shift;
209	return $self->template_zoom_for('index')
210	->apply($self->add_listing(scalar $self->releases, sub {
211	return ((map { $_[1]->$_ } qw/dist distvname/), 'distribution');
212	}));
213	}
214
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 );
221	}
222
223	sub releases {
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' },
229	page => $page,
230	rows => $rows,
231	});
232	}
233
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');
239	}))
240	->apply($self->add_paging($release_rs->pager));
241	}
242
243	sub dists {
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({}, {
248	order_by => 'name',
249	page => $page,
250	rows => $rows,
251	});
252	}
253
254	sub get_dist { return shift->backpan_index->dist(@_) }
255
256	sub format_dist_name { return join(q{::}, split /-/, $_[1] ) }
257
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;
263	return (
264	$dist_name, $self->format_dist_name($dist_name), 'distribution'
265	);
266	}))
267	->apply($self->add_paging($dist_rs->pager));
268	}
269
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' },
275	page => $page,
276	rows => $rows,
277	});
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,
290	})
291	->select('.f_rel_link')->add_to_attribute(
292	href => $backpan_url . $f_release->path->path,
293	)
294	->select('.l_rel_link')->add_to_attribute(
295	href => $backpan_url . $l_release->path->path,
296	)
297	->select('.maintainer-list')->repeat_content([
298	map { my $cpanid = $_; sub {
299	$_->select('a')->add_to_attribute(
300	href => $cpan_search_url . lc "~${cpanid}"
301	)->then
302	->add_to_attribute(target => '_blank')
303	->then
304	->replace_content($cpanid);
305	}
306	} @maints
307	])
308	->apply($self->add_listing($release_rs, sub {
309	my $release = $_;
310	return (
311	$release->distvname,
312	join(q{ \| }, $release->distvname,
313	DateTime->from_epoch({ epoch => $release->date })
314	->strftime('%b %d, %Y - %T')),
315	$backpan_url . $release->path->path,
316	);
317	}))
318	->apply($self->add_paging($release_rs->pager));
319	}
320
321	sub authors {
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 ) {
332	return undef;
333	}
334	else {
335	$pager->current_page($page);
336	return {
337	list => [ splice @authors, ($page-1) * $rows, $rows ],
338	pager => $pager,
339	};
340	}
341	}
342
343	sub authors_page_content {
344	my ( $self, $authors ) = @_;
345	return $self->template_zoom_for('listing')
346	->apply($self->add_listing($authors->{'list'}, sub {
347	my $cpanid = $_[1];
348	return (
349	$cpanid, $cpanid,
350	$self->config->{'cpan_search_url'} . lc "~${cpanid}"
351	);
352	}))
353	->apply($self->add_paging($authors->{'pager'}));
354	}
355
2a30b3c1	356	sub _mangle_query_string {
	357	my ( $self, $q ) = @_;
	358	$q =~ s{\s+\|::\|\+}{-}g;
	359	$q =~ s{-$}{};
	360	return $q =~ s{\*}{}g ? "$q%" : "%$q%";
	361	}
	362
b67ffc2e	363	sub search {
b67ffc2e	364	my ( $self, $q, $query_params ) = @_;
2a30b3c1	365	my $query_str = lc $self->_mangle_query_string($q);
b67ffc2e	366	return $self->dists($query_params)->search({
b67ffc2e	367	-or => [
2a30b3c1	368	{ 'LOWER(me.name)' => { -like => $query_str } },
	369	{ 'LOWER(me.first_author)' => { -like => $query_str } },
	370	{ 'LOWER(me.latest_author)' => { -like => $query_str } },
b67ffc2e	371	],
	372	});
	373	}
	374
	375	dispatch {
	376	subdispatch sub () {
	377	$self->_build_request_obj_from($_[+PSGI_ENV]);
c4e00ace	378	my $base_title = 'BackPAN.org';
b67ffc2e	379	[
	380	sub (/) {
	381	$self->html_response({ body => $self->index_page_content });
	382	},
	383
	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({
	389	header => {
	390	'Last-Modified' => $about_st->mtime,
	391	},
	392	body => $self->slurp($about_filename),
	393	});
	394	},
	395
	396	sub ( /releases\|/releases/ + ?* ) {
	397	my $release_rs = $self->releases($_[1]);
	398	if ( $release_rs->count ) {
2a30b3c1	399	my $body = $self->releases_page_content($release_rs)
c4e00ace	400	->select('#nav-releases')->add_to_attribute(class => 'active')
c4e00ace	401	->select('title')->replace_content(join q{ - }, 'Releases', $base_title);
2a30b3c1	402	return $self->html_response({ body => $body });
b67ffc2e	403	}
b67ffc2e	404	else {
2a30b3c1	405	return $self->html_response({
	406	status_code => 404,
	407	body => $self->error_404,
	408	});
b67ffc2e	409	}
b67ffc2e	410	},
	411
	412	sub ( /dists\|/dists/ + ?* ) {
	413	my $dist_rs = $self->dists($_[1]);
	414	if ( $dist_rs->count ) {
2a30b3c1	415	my $body = $self->dists_page_content($dist_rs)
c4e00ace	416	->select('#nav-dists')->add_to_attribute(class => 'active')
c4e00ace	417	->select('title')->replace_content(join q{ - }, 'Distributions', $base_title);
2a30b3c1	418	return $self->html_response({ body => $body });
b67ffc2e	419	}
b67ffc2e	420	else {
2a30b3c1	421	return $self->html_response({
	422	status_code => 404,
	423	body => $self->error_404,
	424	});
b67ffc2e	425	}
b67ffc2e	426	},
	427
	428	sub ( /distribution/\|/distribution// + ?* ) {
	429	if ( my $dist = $self->get_dist($_[1]) ) {
c4e00ace	430	my $body = $self->dist_info_page_content($dist, $_[2])
c4e00ace	431	->select('title')->replace_content(join q{ - }, $self->format_dist_name($dist->name), $base_title);
2a30b3c1	432	return $self->html_response({ body => $body });
b67ffc2e	433	}
b67ffc2e	434	else {
2a30b3c1	435	return $self->html_response({
	436	status_code => 404,
	437	body => $self->error_404,
	438	});
b67ffc2e	439	}
b67ffc2e	440	},
	441
	442	sub ( /authors\|/authors/ + ?* ) {
	443	if ( my $authors = $self->authors($_[1]) ) {
2a30b3c1	444	my $body = $self->authors_page_content($authors)
c4e00ace	445	->select('#nav-authors')->add_to_attribute(class => 'active')
c4e00ace	446	->select('title')->replace_content(join q{ - }, 'Authors', $base_title);
2a30b3c1	447	return $self->html_response({ body => $body });
b67ffc2e	448	}
b67ffc2e	449	else {
2a30b3c1	450	return $self->html_response({
	451	status_code => 404,
	452	body => $self->error_404,
	453	});
b67ffc2e	454	}
b67ffc2e	455	},
	456
	457	sub ( /search\|/search/ + ?q=&* ) {
2a30b3c1	458	my ( $self, $query_str, $query_params ) = @_;
2a30b3c1	459	my $dist_rs = $self->search($query_str, $query_params);
b67ffc2e	460	if ( $dist_rs->count ) {
2a30b3c1	461	my $body = $self->dists_page_content($dist_rs)
	462	->select('#q')->add_to_attribute(
	463	value => $query_str
c4e00ace	464	)
c4e00ace	465	->select('title')->replace_content(join q{ - }, 'Search', $base_title);
2a30b3c1	466	return $self->html_response({ body => $body });
b67ffc2e	467	}
b67ffc2e	468	else {
2a30b3c1	469	return $self->html_response({
	470	status_code => 404,
	471	body => $self->error_404,
	472	});
b67ffc2e	473	}
b67ffc2e	474	},
	475	],
	476	},
	477	};
	478
	479	sub as_psgi_app {
	480	my $class = shift;
	481	my $app = $class->SUPER::as_psgi_app;
	482	return builder {
	483	enable_if { $ENV{PLACK_ENV} ne 'deployment' }
	484	sub {
	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},
	489	root => './root/',
	490	);
	491	$mw_class = Plack::Util::load_class('Debug', $mw_prefix);
	492	$app = $mw_class->wrap($app,
	493	panels => [qw(DBITrace Memory Timer Environment Response)],
	494	);
	495	$app;
	496	};
	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';
	503	enable 'Head';
c4e00ace	504	#enable 'AccessLog',
	505	# format => 'combined',
	506	# logger => sub { get_logger('accesslog')->info(@_) };
	507	#enable 'Log4perl', conf => 'log/log.conf';
b67ffc2e	508	$app;
	509	};
	510	}
	511
	512	=head1 AUTHOR
	513
	514	Wallace Reis, C<< <wreis at cpan.org> >>
	515
	516	=head1 LICENSE AND COPYRIGHT
	517
cf4e2940	518	© Copyright 2010-2011 Wallace Reis.
b67ffc2e	519
	520	=cut
	521
	522	__PACKAGE__->run_if_script;