view release on metacpan or  search on metacpan

Apache2/Apache2/CPAN/Search.pm  view on Meta::CPAN

package Apache2::CPAN::Search;
use strict;
use warnings;
use utf8;
use mod_perl2 1.999022;     # sanity check for a recent version
use Apache2::Const -compile => qw(OK SERVER_ERROR TAKE1 RSRC_CONF ACCESS_CONF);
use CPAN::Search::Lite::Query;
use CPAN::Search::Lite::Util qw($mode_info $query_info %chaps 
                                %modes $tt2_pages);
our $chaps_desc = {};
our $pages = {};
use CPAN::Search::Lite::Lang qw(%langs load);
use Template;
use File::Spec::Functions qw(catfile catdir);
use Apache2::Request;
use Apache2::Cookie;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use APR::Date;
use APR::URI;
use Apache2::URI;
use Apache2::Module ();
use Apache2::Log ();
our $VERSION = 0.77;

my @directives = (
                  {name      => 'CSL_db',
                   errmsg    => 'database name',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'CSL_user',
                   errmsg    => 'user to log in as',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'CSL_passwd',
                   errmsg    => 'password for user',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'CSL_tt2',
                   errmsg    => 'location of tt2 pages',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'CSL_dl',
                   errmsg    => 'default download location',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'CSL_max_results',
                   errmsg    => 'maximum number of results',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'CSL_html_root',
                   errmsg    => 'root directory of html files',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'CSL_html_uri',
                   errmsg    => 'root uri of html files',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                 );
Apache2::Module::add(__PACKAGE__, \@directives);

my $cookie_name = 'cslmirror';
my ($template, $query, $cfg, $dl, $max_results);

sub new {
    my ($class, $r) = @_;
    my $lang = lang_wanted($r);
    my $req = Apache2::Request->new($r);
    $cfg = Apache2::Module::get_config(__PACKAGE__,
                                      $r->server,
                                      $r->per_dir_config) || { };
    $dl = $cfg->{dl} || 'http://www.cpan.org';
    $max_results ||= $cfg->{max_results} || 200;
    my $passwd = $cfg->{passwd} || '';

    $template ||= Template->new({
                                 INCLUDE_PATH => [$cfg->{tt2},
                                                  Template::Config->instdir('templates')],
                                 PRE_PROCESS => ['config', 'header'],
                                 POST_PROCESS => 'footer',
                                 POST_CHOMP => 1,
                                }) || do {
                                  $r->log_error(Template->error());
                                  return Apache2::Const::SERVER_ERROR;
                                };

    $query ||= CPAN::Search::Lite::Query->new(db => $cfg->{db},
                                              user => $cfg->{user},
                                              passwd => $passwd,
                                              max_results => $max_results);
    $CPAN::Search::Lite::Query::lang = $lang;
    unless ($pages->{$lang}) {
      my $rc = load(lang => $lang, pages => $pages, chaps_desc => $chaps_desc);
      unless ($rc == 1) {
        $r->log_error($rc);
        return;
      }
    }
    my $mode = $req->param('mode');
    unless ($mode && $mode eq 'mirror') {
        if ($r->protocol =~ /(\d\.\d)/ && $1 >= 1.1) {
            $r->headers_out->{'Cache-Control'} = 'max-age=36000';
        }
        else {
            $r->headers_out->{Expires} = APR::Date::parse_http(time+36000);
        }
    }

    my $mirror;
    if (my $host = ($req->param('host') || $req->param('url') )) {
        my $cookie = Apache2::Cookie->new($r, name => $cookie_name,
                                         value => $host, expires => '+1y');
        $cookie->bake;
        $mirror = $host;
   }
    else {
        my %cookies = Apache2::Cookie->fetch($r);
        if (my $c = $cookies{$cookie_name}) {
            $mirror = $c->value; 
        }
    }
    $mirror ||= $dl;
    $r->content_type('text/html; charset=UTF-8');

    my $self = {mode => $mode,
                mirror => $mirror, req => $req, lang => $lang};
    bless $self, $class;
}

sub search : method {
    my ($self, $r) = @_;
    $self = __PACKAGE__->new($r) 
        unless ref($self) eq __PACKAGE__;
    
    my $req = $self->{req};

    my $mode = $self->{mode};
    my $query_term = trim($req->param('query'));
    my $letter = $req->param('letter');
    my $chapterid = $req->param('chapterid');
    my $recent = $req->param('recent');
    my $subchapter = $req->param('subchapter');
    my ($page, $results, %extra_info, $age);
    
  MODE: {
        (defined $mode and $mode eq 'mirror') and do {
            my %save;
            if (my $referer = $r->headers_in->{Referer}) {
                my $parsed = APR::URI->parse($r->pool, $referer);
                my $qs = $parsed->query;
                %save = parse_qs($qs);
                delete $save{host};
                delete $save{url};
            }
            $extra_info{save} = \%save;
            $page = 'mirror';
            last MODE;
        };
        (defined $mode and $mode eq 'chapter') and do {
            $results = $self->chap_results();
            $page = $results ? 'chapterid' : 'missing';
            last MODE;
        };
        (defined $chapterid) and do {
            my %args;
            $args{mode} = $mode = 'chapter';
            $args{id} = $chapterid;
            $extra_info{chapterid} = $chapterid;
            $extra_info{chapter_link} = $chaps{$chapterid};
            $extra_info{chapter_desc} = $chaps_desc->{$self->{lang}}->{$chapterid};
            if ($subchapter) {
                $args{subchapter} = $subchapter;
                $extra_info{subchapter} = $subchapter;
                $page = $tt2_pages->{$mode}->{search};
            }
            else {
                $page = $tt2_pages->{$mode}->{info};

Apache2/Apache2/CPAN/Search.pm  view on Meta::CPAN

  for (reverse sort {$a <=> $b} keys %wanted) {
    return $wanted{$_} if $langs{$wanted{$_}};
  }
  return 'en';
}

sub CSL_db {
  my ($cfg, $parms, $db) = @_;
  $cfg->{ db } = $db;
}

sub CSL_user {
  my ($cfg, $parms, $user) = @_;
  $cfg->{ user } = $user;
}

sub CSL_passwd {
  my ($cfg, $parms, $passwd) = @_;
  $passwd = '' unless $passwd =~ /\w/;
  $cfg->{ passwd } = $passwd;
}

sub CSL_tt2 {
  my ($cfg, $parms, $tt2) = @_;
  $cfg->{ tt2 } = $tt2;
}

sub CSL_dl {
  my ($cfg, $parms, $dl) = @_;
  $cfg->{ dl } = $dl;
}

sub CSL_max_results {
  my ($cfg, $parms, $max_results) = @_;
  $cfg->{ max_results } = $max_results;
}

sub CSL_html_root {
  my ($cfg, $parms, $html_root) = @_;
  $cfg->{ html_root } = $html_root;
}

sub CSL_html_uri {
  my ($cfg, $parms, $html_uri) = @_;
  $cfg->{ html_uri } = $html_uri;
}

1;


__END__

=head1 NAME

Apache2::CPAN::Search - mod_perl interface to CPAN::Search::Lite::Query

=head1 DESCRIPTION

This module provides a mod_perl (2) interface to CPAN::Search::Lite::Query.
The modules C<Apache2::Request>
and C<Apache2::Cookie> of the C<libapreq2> distribution
are required. A directive

    PerlLoadModule Apache2::CPAN::Search

should appear before any of the C<Location> directives
using the module. As well, the following directives should
be defined in the Apache configuration file.

=over 3

=item C<CSL_db database>

the name of the database [required]

=item C<CSL_user user>

the user to connect to the database as [required]

=item C<CSL_passwd password>

the password to use for this user [optional if no password
is required for the user specified in C<CSL_user>.]

=item C<CSL_tt2 /path/to/tt2>

the path to the tt2 pages [required]. 

=item C<CSL_dl http://www.cpan.org>

the default download location [optional - http://www.cpan.org will
be used if not specified]

=item C<CSL_max_results 200>

the maximum number of results to obtain [optional - 200 will be
used if not specified]

=back

The response handler can then be specified as

 <Location "/search">
   SetHandler perl-script
   PerlResponseHandler Apache2::CPAN::Search->search
 </Location>

A request for C<http://localhost/search> without any
query string will bring up a page of chapterid listings.
All other requests are handled through the query string
arguments.

=over 3

=item C<mode=$value>

What results depends on the C<$value> of C<mode>

=over 3

=item C<mode=dist>, C<mode=author>, C<mode=module>