Apache2::DocServer - mod_perl 2 soap server for soap-enhanced perldoc

• NAME
• DESCRIPTION
• SEE ALSO

Code Index:

• package Apache2::DocServer
  • get_doc
  • get_readme
  • DocServer_db
  • DocServer_user
  • DocServer_passwd
  • DocServer_max_results
  • DocServer_pod_root
• __END__
• EOF

NAME

Apache2::DocServer - mod_perl 2 soap server for soap-enhanced perldoc

DESCRIPTION

This module provides a mod_perl 2 soap-based service to Pod::Perldocs. The necessary Apache2 directives are

 PerlLoadModule Apache2::DocServer

 DocServer_db database_name
 DocServer_user user_name
 DocServer_passwd password_for_above_user
 DocServer_pod_root "/Path/to/pod/root"

 <Location /docserver>
   SetHandler perl-script
   PerlResponseHandler Apache2::SOAP
   PerlSetVar dispatch_to "D:/Perl/site/lib/Apache2, Apache2::DocServer"
 </Location>

where the Apache2::SOAP module, included in this distribution, is a mod_perl 2 aware version of Apache2::SOAP of the SOAP::Lite distribution. See the perldocs script in this distribution for an example of it's use.

SEE ALSO

the Pod::Perldocs manpage.

package Apache2::DocServer;
use strict;
use warnings;
use DBI;
use File::Spec::Functions;
use CPAN::Search::Lite::Query;
use mod_perl 1.999022;     # sanity check for a recent version
use Apache2::Const -compile => qw(OK REDIRECT SERVER_ERROR 
                                 TAKE1 RSRC_CONF ACCESS_CONF);
use Apache2::Module ();
use Apache2::RequestRec ();
our ($VERSION);
$VERSION = 0.66;

my @directives = (
                  {name      => 'DocServer_db',
                   errmsg    => 'database name',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'DocServer_user',
                   errmsg    => 'user to log in as',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'DocServer_pod_root',
                   errmsg    => 'root directory of pod files',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'DocServer_passwd',
                   errmsg    => 'password for user',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                  {name      => 'DocServer_max_results',
                   errmsg    => 'maximum number of results',
                   args_how  => Apache2::Const::TAKE1,
                   req_override => Apache2::Const::RSRC_CONF | Apache2::Const::ACCESS_CONF,
                  },
                 );
Apache2::Module::add(__PACKAGE__, \@directives);

my ($query, $cfg, $r, $max_results);

sub get_doc {
  my ($class, $mod) = @_;
  $mod =~ s!(\.pm|\.pod)$!!;
  return unless ($mod =~ m!^[\w:\.\-]+$!);
  $r = Apache->request;
  $cfg = Apache2::Module::get_config(__PACKAGE__, 
                                    $r->server,
                                    $r->per_dir_config) || { };

  $max_results ||= $cfg->{max_results} || 200;
  $query ||= CPAN::Search::Lite::Query->new(db => $cfg->{db},
                                            user => $cfg->{user},
                                            passwd => $cfg->{passwd},
                                            max_results => $max_results);
  my $fields = [qw(doc dist_name)];
  $query->query(mode => 'module', name => $mod, fields => $fields);
  my $results = $query->{results};
  return unless $results;
  my ($doc, $dist_name) = ($results->{doc}, $results->{dist_name});
  return unless ($doc and $dist_name);
    
  my $base = catfile $cfg->{pod_root}, $dist_name, (split '::', $mod);
  my $file;
  for my $ext ('.pm', '.pod') {
    my $trial = $base . $ext;
    if (-f $trial) {
      $file = $trial;
      last;
    }
  }
  return unless $file;
  open (my $fh, $file) or return;
  my @lines = <$fh>;
  close $fh;
  return \@lines;
}

sub get_readme {
  my ($class, $dist) = @_;
  return unless ($dist =~ m!^[\w:\.\-]+$!);
  $r ||= Apache->request;
  $cfg ||= Apache2::Module->get_config(__PACKAGE__, 
                                      $r->server,
                                      $r->per_dir_config) || { };
  
  $max_results ||= $cfg->{max_results} || 200;
  $query ||= CPAN::Search::Lite::Query->new(db => $cfg->{db},
                                            user => $cfg->{user},
                                            passwd => $cfg->{passwd},
                                            max_results => $max_results);
  my $fields = [qw(readme)];
  $query->query(mode => 'dist', name => $dist, fields => $fields);
  my $results = $query->{results};
  return unless ($results and $results->{readme});
  
  my $file = catfile $cfg->{pod_root}, $dist, 'README';
  return unless (-f $file);
  open (my $fh, $file) or return;
  my @lines = <$fh>;
  close $fh;
  return \@lines;
}

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

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

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

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

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


1;

__END__