Apache2::CPAN::Query - mod_perl interface to CPAN::Search::Lite::Query
This module provides a mod_perl (2) interface to CPAN::Search::Lite::Query.
The modules Apache2::Request
and Apache2::Cookie
of the libapreq2
distribution
are required. A directive
PerlLoadModule Apache2::CPAN::Query
should appear before any of the Location
directives
using the module. As well, the following directives should
be defined in the Apache configuration file.
CSL_db database
CSL_user user
CSL_passwd password
CSL_user
.]
CSL_tt2 /path/to/tt2
CSL_dl http://www.cpan.org
CSL_max_results 200
CSL_html_root /usr/local/httpd/CPAN
CSL_html_uri http://you.org/CPAN/docs
Available response handlers are as follows.
<Location "/search"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->search </Location>
This handles search queries such as for
http://localhost/search?mode=dist;query=libnet.
mode
can be one of dist
, module
, or author
.
A search using the specified query
will be done on, respectively, distribution names and abstracts,
module names and abstracts, and CPAN ids and full names.
<LocationMatch "/~[A-Za-z0-9-]+"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->cpanid </LocationMatch>
There are two levels:
CPANID
.
Dist-Name
of cpanid CPANID
.
<Location "/author"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->author </Location>
There are 3 levels:
CPANID
.
A
.
<Location "/dist"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->dist </Location>
There are 4 levels:
Dist-Name
.
A
.
ABC-*
.
<Location "/module"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->module </Location>
There are 4 levels:
Mod::Name
.
A
.
ABC::*
.
<Location "/chapter"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->chapter </Location>
There are 3 levels:
%chaps
of CPAN::Search::Lite::Util
).
Data Type Utilities
chapter.
Tie
subchapter of the Data Type Utilities
chapter.
<Location "/recent"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->recent </Location>
With this, a request for http://localhost/recent will list all distributions uploaded in the last 7 days.
<Location "/mirror"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->mirror </Location>
With this, a request for http://localhost/mirror will bring up a page whereby the user can change the location of where downloads will be redirected to. This requires cookies to be enabled.
<Location "/perldoc"> SetHandler perl-script PerlResponseHandler Apache2::CPAN::Query->perldoc </Location>
With this, a request for, eg, http://localhost/perldoc/perlfaq will be redirected to the perfaq documentation, and a request for, eg, http://localhost/perldoc/Net::FTP, will be redirected to the documentation for Net::FTP.
the Apache2::CPAN::Search manpage, the CPAN::Search::Lite::Query manpage, and mod_perl.
package Apache2::CPAN::Query; use strict; use warnings; use utf8; use mod_perl2 1.999022; # sanity check for a recent version use Apache2::Const -compile => qw(OK REDIRECT SERVER_ERROR TAKE1 RSRC_CONF ACCESS_CONF); use CPAN::Search::Lite::Query; use CPAN::Search::Lite::Util qw($mode_info $query_info %modes %chaps_rev %chaps $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 Apache2::Module (); use Apache2::Log (); use APR::Date; use APR::URI; use Apache2::URI; our ($VERSION); $VERSION = 0.66; 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') || 'dist'; unless ($r->location 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, path => '/', 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, html_root => $cfg->{html_root}, lang => $lang, html_uri => $cfg->{html_uri}, title => $pages->{$lang}->{title}}; bless $self, $class; } sub search : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $req = $self->{req}; my $query_term = trim($req->param('query')); return $self->chapter($r) unless $query_term; my $mode = $self->{mode}; $mode = 'module' if $query_term =~ /::/; $query_term =~ s{\.pm$}{} if ($mode eq 'module'); my ($results, $page, %extra_info); $query->query(mode => $mode, query => $query_term); if ($results = $query->{results}) { $page = ref($results) eq 'ARRAY' ? $tt2_pages->{$mode}->{search} : $tt2_pages->{$mode}->{info}; } else { $page = 'missing'; } unless (ref($results) eq 'ARRAY') { my $name; if ($mode and $mode_info->{$mode}->{name} and $name = $results->{$mode_info->{$mode}->{name}}) { if ($name =~ /^(\w)(\w)/) { my ($a, $b) = (uc($1), uc($2)); $extra_info{letter} = $a; $extra_info{cpan_letter} = "$a/$a$b"; } 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}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } my $vars = {results => $results, query => $query_term, mode => $mode, mirror => $self->{mirror}, %extra_info, pages => $pages->{$self->{lang}}, title => $self->{title}, }; $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub cpanid : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $uri = $r->uri; my ($mode, $results, $page); my ($cpanid, $dist_name) = $uri =~ m!^/~([^/]+)/?(.*)!; if ($dist_name) { $mode = 'dist'; $query->query(mode => $mode, name => $dist_name); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{info} : 'letters'; } elsif ($cpanid) { $mode = 'author'; $query->query(mode => $mode, name => $cpanid); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{info} : 'letters'; } else { $mode = 'author'; $page = 'letters'; } my %extra_info; unless (ref($results) eq 'ARRAY') { if (my $name = $results->{$mode_info->{$mode}->{name}}) { if ($name =~ /^(\w)(\w)/) { my ($a, $b) = (uc($1), uc($2)); $extra_info{letter} = $a; $extra_info{cpan_letter} = "$a/$a$b"; $extra_info{title} = sprintf("%s : %s", $self->{title}, $name); } if ($mode eq 'dist' and $name =~ /^([^-]+)-/) { $extra_info{subletter} = $1; $extra_info{title} = sprintf("%s : %s", $self->{title}, $name); } if ($mode eq 'module' and $name =~ /^([^:]+)::/) { $extra_info{subletter} = $1; $extra_info{title} = sprintf("%s : %s", $self->{title}, $name); } } } my $vars = {results => $results, mode => $mode, mirror => $self->{mirror}, title => $self->{title}, %extra_info, pages => $pages->{$self->{lang}}, }; if (my $error = $query->{error}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub author : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $path_info = $r->path_info; my $mode = 'author'; my ($page, $cpanid, $letter, $results); if ($path_info =~ m!^/([^/]+)!) { my $match = $1; if ($path_info =~ m!/$!) { $letter = $match; } else { $cpanid = $match; } } if ($letter) { $query->query(mode => $mode, letter => $letter); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{letter} : 'letters'; } elsif ($cpanid) { $query->query(mode => $mode, name => $cpanid); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{info} : 'letters'; } else { $page = 'letters'; } my %extra_info; unless (ref($results) eq 'ARRAY') { if (my $name = $results->{$mode_info->{$mode}->{name}}) { if ($name =~ /^(\w)(\w)/) { my ($a, $b) = (uc($1), uc($2)); $extra_info{letter} = $a; $extra_info{cpan_letter} = "$a/$a$b"; $extra_info{title} = sprintf("%s : %s", $self->{title}, $name); } if ($mode eq 'dist' and $name =~ /^([^-]+)-/) { $extra_info{subletter} = $1; $extra_info{title} = sprintf("%s : %s", $self->{title}, $name); } } } my $vars = {results => $results, mode => $mode, mirror => $self->{mirror}, letter => $letter, title => $self->{title}, %extra_info, pages => $pages->{$self->{lang}}, }; if (my $error = $query->{error}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub dist : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $path_info = $r->path_info; my $mode = 'dist'; my ($page, $dist_name, $letter, $results); if ($path_info =~ m!^/([^/]+)!) { my $match = $1; if ($path_info =~ m!/$!) { $letter = $match; } else { $dist_name = $match; } } if ($letter) { $query->query(mode => $mode, letter => $letter); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{letter} : 'letters'; } elsif ($dist_name) { $query->query(mode => $mode, name => $dist_name); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{info} : 'letters'; } else { $page = 'letters'; } if ($letter and ref($results) eq 'ARRAY' and @$results == 1) { $r->headers_out->set(Location => "/dist/$results->[0]->{dist_name}"); return Apache2::Const::REDIRECT; } my %extra_info; unless (ref($results) eq 'ARRAY') { if (my $name = $results->{$mode_info->{$mode}->{name}}) { if ($name =~ /^(\w)/) { $extra_info{letter} = $letter = uc($1); } if ($name =~ /^([^-]+)-/) { $extra_info{subletter} = $1; } $extra_info{title} = sprintf("%s : %s", $self->{title}, $name); } } unless ($letter and $letter =~ /^\w$/) { $extra_info{subletter} = $letter; ($extra_info{letter} = $letter) =~ s/^(\w).*/$1/ if $letter; } if (my $error = $query->{error}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } my $vars = {results => $results, mode => $mode, mirror => $self->{mirror}, letter => $letter, title => $self->{title}, %extra_info, pages => $pages->{$self->{lang}}, }; $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub module : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $path_info = $r->path_info; my $mode = 'module'; my ($page, $mod_name, $letter, $results); if ($path_info =~ m!^/([^/]+)!) { my $match = $1; if ($path_info =~ m!/$!) { $letter = $match; } else { $mod_name = $match; } } if ($letter) { $query->query(mode => $mode, letter => $letter); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{letter} : 'letters'; } elsif ($mod_name) { $query->query(mode => $mode, name => $mod_name); $results = $query->{results}; $page = $results ? $tt2_pages->{$mode}->{info} : 'letters'; } else { $page = 'letters'; } if ($letter and ref($results) eq 'ARRAY' and @$results == 1) { $r->headers_out->set(Location => "/module/$results->[0]->{mod_name}"); return Apache2::Const::REDIRECT; } my %extra_info; unless (ref($results) eq 'ARRAY') { if (my $name = $results->{$mode_info->{$mode}->{name}}) { if ($name =~ /^(\w)/) { $extra_info{letter} = $letter = uc($1); } if ($name =~ /^([^:]+)::/) { $extra_info{subletter} = $1; } $extra_info{title} = sprintf("%s : %s", $self->{title}, $name); } } unless ($letter and $letter =~ /^\w$/) { $extra_info{subletter} = $letter; ($extra_info{letter} = $letter) =~ s/^(\w).*/$1/ if $letter; } if (my $error = $query->{error}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } my $vars = {results => $results, mode => $mode, mirror => $self->{mirror}, letter => $letter, title => $self->{title}, %extra_info, pages => $pages->{$self->{lang}}, }; $template->process($page, $vars, $r, binmode => ':utf8')or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub chapter : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $path_info = $r->path_info; my $mode = 'chapter'; my ($results, $page, %extra_info); if (not $path_info) { $results = $self->chap_results(); $page = $results ? 'chapterid' : 'missing'; } my ($chapter, $subchapter); if ($path_info) { if ($path_info =~ m!^/([^/]+)/?(.*)!) { ($chapter, $subchapter) = ($1, $2); } $chapter = undef if (not defined $chaps_rev{$chapter}); } if (not defined $chapter) { $results = $self->chap_results(); $page = $results ? 'chapterid' : 'missing'; } else { my %args; $args{mode} = $mode; $args{id} = $chaps_rev{$chapter}; $extra_info{chapter} = $chapter; my $chapter_desc = $chaps_desc->{$self->{lang}}->{$args{id}}; $extra_info{chapter_desc} = $chapter_desc; $extra_info{title} = sprintf("%s : %s", $self->{title}, $chapter_desc); if ($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}; $page = 'missing' unless $results; if ($subchapter and ref($results) eq 'ARRAY' and @$results == 1) { $r->headers_out->set(Location => "/dist/$results->[0]->{dist_name}"); return Apache2::Const::REDIRECT; } } if (my $error = $query->{error}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } my $vars = {results => $results, mode => $mode, mirror => $self->{mirror}, title => $self->{title}, %extra_info, pages => $pages->{$self->{lang}}, }; $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub mirror : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $mode = 'mirror'; my (%save, %extra_info, $path); if (my $referer = $r->headers_in->{Referer}) { my $parsed = APR::URI->parse($r->pool, $referer); my $qs = $parsed->query; $path = $parsed->path; %save = parse_qs($qs); delete $save{host}; delete $save{url}; } $extra_info{save} = \%save; my $page = 'mirror'; if (my $error = $query->{error}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } my $title = sprintf("%s : %s", $self->{title}, 'mirror'); my $vars = {mode => $mode, mirror => $self->{mirror}, path => $path, title => $title, %extra_info, pages => $pages->{$self->{lang}}, }; $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub recent : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $req = $self->{req}; my $age = $req->param('age') || 7; my $mode = 'dist'; $query->query(mode => $mode, recent => $age); my $results = $query->{results}; my $page = $results ? 'recent' : 'missing'; if (my $error = $query->{error}) { $r->log->error($error); $query->{error} = undef; $page = 'error'; } my $title = sprintf("%s : %s", $self->{title}, 'recent uploads'); my $vars = {results => $results, mode => $mode, mirror => $self->{mirror}, age => $age, title => $title, pages => $pages->{$self->{lang}}, }; $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } sub perldoc : method { my ($self, $r) = @_; $self = __PACKAGE__->new($r) unless ref($self) eq __PACKAGE__; my $path_info = $r->path_info; my $mode = 'module'; my ($page, $request, $results); if (not $path_info) { $results = $self->chap_results(); $page = $results ? 'chapterid' : 'missing'; } else { if ($path_info =~ m!^/([^/]+)!) { $request = $1; } else { $results = $self->chap_results(); $page = $results ? 'chapterid' : 'missing'; } } my $vars; if ($page) { $vars = {results => $results, mirror => $self->{mirror}, pages => $pages->{$self->{lang}}, title => $self->{title}, }; $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } my $parsed = $r->parsed_uri(); my $html_root = $self->{html_root}; my ($scheme, $host, $path) = $self->{html_uri} =~ m!(\w+)://([^/]+/)(.*)!; $parsed->hostname($host); $parsed->port(80); $parsed->scheme($scheme); my $perl_file = catfile $html_root, 'perl', $request; $perl_file .= '.html'; if (-f $perl_file) { $path = File::Spec::Unix->catfile($path, 'perl', $request); $parsed->path($path . '.html'); $r->headers_out->set(Location => $parsed->unparse()); return Apache2::Const::REDIRECT; } $query->query(mode => 'module', name => $request); $results = $query->{results}; my $dist_name = $results->{dist_name}; my $mod_file = catfile $html_root, $dist_name, split(/::/, $request); $mod_file .= '.html'; unless ($results->{doc} and -f $mod_file) { $page = 'not_found'; $vars = {request => $request, mirror => $self->{mirror}, pages => $pages->{$self->{lang}}, mode => 'perldoc', }; $template->process($page, $vars, $r, binmode => ':utf8') or do { $r->log_error($template->error()); return Apache2::Const::SERVER_ERROR; }; return Apache2::Const::OK; } $path = File::Spec::Unix->catfile($path, $dist_name, split(/::/, $request)); $parsed->path($path . '.html'); $r->headers_out->set(Location => $parsed->unparse()); return Apache2::Const::REDIRECT; } sub chap_results { my $self = shift; my $chapters; foreach my $key( sort {$a <=> $b} keys %chaps) { push @$chapters, {chapterid => $key, chap_link => $chaps{$key}, chap_desc => $chaps_desc->{$self->{lang}}->{$key}, }; } return $chapters; } sub parse_qs { my $qs = shift; return unless $qs; my %args = map { tr/+/ /; s/%([0-9a-fA-F]{2})/pack("C",hex($1))/ge; $_; } split /[=&;]/, $qs, -1; return %args; } sub trim { my $string = shift; return unless $string; $string =~ s/^\s+//; $string =~ s/\s+$//; $string =~ s/\s+/ /g; $string =~ s/\"|\'|\\//g; return ($string =~ /\w/) ? $string : undef; } sub lang_wanted { my $r = shift; my $accept = $r->headers_in->{'Accept-Language'}; return 'en' unless $accept; my %wanted; foreach my $lang(split /,/, $accept) { if ($lang !~ /;/) { $lang =~ s{(\w+)-\w+}{$1}; $wanted{1} = lc $lang; } else { my @q = split /;/, $lang, 2; $q[1] =~ s{q=}{}; $q[1] = trim($q[1]); $q[0] =~ s{(\w+)-\w+}{$1}; $wanted{$q[1]} = lc trim($q[0]); } } 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) = @_; $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; } #sub DESTROY { # $dbh->disconnect; #} 1; __END__