#!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};
$page = ref($results) eq 'ARRAY' ?
$tt2_pages->{$mode}->{search} :
$tt2_pages->{$mode}->{info};
last MODE;
};
($mode and $letter) and do {
$query->query(mode => $mode, letter => $letter);
$results = $query->{results};
$page = $tt2_pages->{$mode}->{letter};
unless ($letter =~ /^\w$/) {
$extra_info{subletter} = $letter;
($extra_info{letter} = $letter) =~ s/^(\w).*/$1/;
}
last MODE;
};
($recent) and do {
$mode = 'dist';
$age = $params{recent} || 7;
$query->query(mode => $mode,
recent => $age);
$results = $query->{results};
$page = 'recent';
last MODE;
};
foreach my $what (keys %$query_info) {
next unless my $value = $params{$what};
$mode = $query_info->{$what}->{mode};
my $type = $query_info->{$what}->{type};
$query->query(mode => $mode,
$type => $value);
$results = $query->{results};
$page = ref($results) eq 'ARRAY' ?
$tt2_pages->{$mode}->{search} :
$tt2_pages->{$mode}->{info};
last MODE;
};
(defined $mode) and do {
$results->{mode} = $mode;
$page = 'letters';
last MODE;
};
$page = 'missing';
}
$page = 'missing' unless ($results and $page);
unless (ref($results) eq 'ARRAY') {
if (my $name = $results->{$mode_info->{$mode}->{name}}) {
if ($name =~ /^(\w)/) {
$extra_info{letter} = uc($1);
}
if ($mode eq 'dist' and $name =~ /^([^-]+)-/) {
$extra_info{subletter} = $1;
}
if ($mode eq 'module' and $name =~ /^([^:]+)::/) {
$extra_info{subletter} = $1;
}
}
}
if (my $error = $query->{error}) {
print STDERR $error;
$page = 'error';
}
}
my $vars = {results => $results,
query => $query_term,
mode => $mode,
letter => $letter,
age => $age,
mirror => $mirror,
%extra_info,
};
$template->process($page, $vars)
|| die "Template process failed: ", $template->error(), "\n";
sub chap_results {
my $chapters;
foreach my $key( sort {$a <=> $b} keys %chaps) {
push @$chapters, {chapterid => $key,
chap_desc => $chaps{$key}
};
}
return $chapters;
}
sub trim {
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
$string =~ s/\s+/ /g;
$string =~ s/\"|\'//g;
return $string;
}
__END__
=head1 NAME
search - cgi interface to C<CPAN::Search::Lite::Query>
=head1 DESCRIPTION
Place this script in your web server's cgi-bin directory.
A request for C<http://localhost/cgi-bin/search> without
any query string will result in a page listing all chapter ids.
All other requests are handled by the query string arguments,
which are described in L<Apache::CPAN::Search>.
=head1 NOTE
Make sure to check the values of C<$db>, C<$user>,
C<$passwd>, and C<$tt2> at the top of this file.
=head1 SEE ALSO
L<Apache::CPAN::Search>, L<Apache::CPAN::Query>,
and L<CPAN::Search::Lite::Query>.
=cut