CPAN-Search-Lite

 view release on metacpan or  search on metacpan

cgi-bin/search  view on Meta::CPAN

#!D:/Perl/bin/perl
use strict;
use CPAN::Search::Lite::Query;
use CPAN::Search::Lite::Util qw($mode_info $query_info %chaps $tt2_pages);
use Template;
use CGI ':standard';
use CGI::Cookie;
use File::Spec::Functions qw(catfile);
my $q = CGI->new();

###############################################################
# Change the following to reflect your setup
my $db = '';                       # name of the database
my $user = '';                     # user to connect as
my $passwd = '';                   # password for this user
my $tt2 = '';                      # tt2 pages
my $max_results = 200;               # maximum results to report
###############################################################

my $template = Template->new({
                              INCLUDE_PATH => [$tt2,
                                               Template::Config->instdir('templates')],
                              PRE_PROCESS => ['config', 'header'],
                              POST_PROCESS => 'footer',
                             }) or die Template->error();
my ($results, $page, $query_term, %extra_info, 
    $letter, $age, $mirror, $mode);
my %params = $q->Vars;
my $host = delete $params{host} || delete $params{url};
delete $params{url};

if (defined $host) {
    my $cookie = CGI::Cookie->new(-name => 'cpan_search_mirror',
                                  -value => $host,
                                  -expires => '+1y');
    print $q->header(-cookie => $cookie, -expires => '+2h');
}
else {
    my $expires = ($mode eq 'mirror') ? 'now' : '+2h';
    print $q->header(-expires => $expires);
}
if (not %params) {
    $results = chap_results();
    $page = 'chapterid';
}
else {
    my $query = CPAN::Search::Lite::Query->new(db => $db,
                                               user => $user,
                                               passwd => $passwd,
                                               max_results => $max_results);

    my %cookies = fetch CGI::Cookie;
    unless ($mirror = $host) {
        if ($cookies{cpan_search_mirror}) {
            $mirror = $cookies{cpan_search_mirror}->value;
        }
    }
    $mode = $params{mode};
    my %modes = map {$_ => 1} keys %$mode_info;

    $query_term = trim($params{query});
    $letter = $params{letter};
    my $chapterid = $params{chapterid};
    my $recent = exists $params{recent};
  MODE: {
        ($mode and $mode eq 'mirror') and do {
            my %save;
            if (my $referer = $q->referer) {
                (my $string = $referer) =~ s!.*?\?(.*)!$1!;
                %save = map {
                    tr/+/ /;
                    s/%([0-9a-fA-F]{2})/pack("C",hex($1))/ge;
                    $_;
                } split /[=&;]/, $string, -1;
            }
            delete $save{host};
            delete $save{url};
            $results = {save => \%save};
            $page = 'mirror';
            last MODE;
        };
        ($mode eq 'chapter') and do {
            $results = chap_results();
            $page = 'chapterid';
            last MODE;
        };
        ($chapterid) and do {
            my %args;
            $args{mode} = $mode = 'chapter';
            $args{id} = $chapterid;
            $extra_info{chapterid} = $chapterid;
            $extra_info{chapter_desc} = $chaps{$chapterid};
            if (my $subchapter = $params{subchapter}) {
                $args{subchapter} = $subchapter;
                $extra_info{subchapter} = $subchapter;
                $page = $tt2_pages->{$mode}->{search};
            }
            else {
                $page = $tt2_pages->{$mode}->{info};
            }
            $query->query(%args);
            $results = $query->{results};
            last MODE;
        };
        ($mode and not $modes{$mode}) and do {
            $page = 'missing';
            last MODE;
        };
        
        ($mode and $query_term) and do {
            $query->query(mode => $mode, query => $query_term);
            $results = $query->{results};



( run in 0.547 second using v1.01-cache-2.11-cpan-f56aa216473 )