home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / WAIT.pm < prev    next >
Encoding:
Perl POD Document  |  2000-03-23  |  11.4 KB  |  379 lines
  1. #                              -*- Mode: Perl -*- 
  2. # $Basename: WAIT.pm $
  3. # $Revision: 1.6 $
  4. # Author          : Ulrich Pfeifer
  5. # Created On      : Fri Jan 31 11:30:46 1997
  6. # Last Modified By: Ulrich Pfeifer
  7. # Last Modified On: Thu Mar 23 21:19:20 2000
  8. # Language        : CPerl
  9. # Update Count    : 145
  10. # Status          : Unknown, Use with caution!
  11. # 
  12. # (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
  13. # 
  14. # 
  15.  
  16. package CPAN::WAIT;
  17. use ExtUtils::MakeMaker; # MM->catfile
  18.  
  19. # try to avoid 'use'ing CPAN.pm
  20. # code stolen from CPAN::Config::load ;
  21.  
  22. eval {require CPAN::Config;};       # We eval because of some
  23.                                     # MakeMaker problems
  24. unless ($CPAN::dot_cpan++){
  25.   unshift @INC, MM->catdir($ENV{HOME},".cpan");
  26.   eval {require CPAN::MyConfig;};   # where you can override
  27.                                     # system wide settings
  28.   shift @INC;
  29. }
  30.  
  31.  
  32.  
  33. require WAIT::Client;
  34. require FileHandle;
  35. use vars qw($VERSION $DEBUG $TIMEOUT);
  36.  
  37. # $Format: "\$\V\E\R\S\I\O\N = '$ModuleVersion$';"$ MM_Unix bug
  38. $VERSION = '0.27';
  39. $TIMEOUT = 20;                  # Set this to some larger value if you
  40.                                 # have a slow connection.
  41.  
  42. sub _open_connection () {
  43.   my ($host, $port, $con);
  44.   
  45.   # Make sure that there is a wait server to try
  46.   unless ($CPAN::Config->{'wait_list'}) {
  47.     $CPAN::Config->{'wait_list'} = ['wait://ls6.informatik.uni-dortmund.de'];
  48.   }
  49.   
  50.   # Try direct connection
  51.   my $server;
  52.  SERVER:
  53.   for $server (@{$CPAN::Config->{'wait_list'}}) {
  54.     warn "CPAN::WAIT $VERSION checking $server\n" if $DEBUG;
  55.     if ($server =~ m(^wait://([^:]+)(?::(\d+))?)) {
  56.       ($host, $port) = ($1, $2 || 1404);
  57.       # Constructor is inherited from Net::NNTP
  58.       $con = WAIT::Client->new($host, Port => $port, Timeout => $TIMEOUT)
  59.         unless $DEBUG and $DEBUG =~ /force proxy/;
  60.       last SERVER if $con;
  61.     }
  62.   }
  63.   
  64.   # Try connection via an http proxy
  65.   unless ($con) {
  66.     warn "Could not connect to the WAIT server at $host port $port\n"
  67.       unless $DEBUG and $DEBUG =~ /force proxy/;
  68.     
  69.     if ($CPAN::Config->{'http_proxy'}) {
  70.       print "Trying your http proxy $CPAN::Config->{'http_proxy'}\n";
  71.     SERVER:
  72.       for $server (@{$CPAN::Config->{'wait_list'}}) {
  73.         if ($server =~ m(^wait://([^:]+)(?::(\d+))?)) {
  74.           ($host, $port) = ($1, $2 || 1404);
  75.           $con = WAIT::Client::HTTP->new($host,
  76.                                          Port  => $port,
  77.                                          Proxy => $CPAN::Config->{'http_proxy'},
  78.                                          Timeout => $TIMEOUT);
  79.           last SERVER if $con;
  80.         }
  81.       }
  82.       warn "No luck with your proxy either. Giving up\n"
  83.         unless $con;
  84.     } else {
  85.       warn "You did not tell the CPAN module about an http proxy.\n" .
  86.         "I could use such a beast instead of a direct connection.\n";
  87.     }
  88.   }
  89.   
  90.   # We had no luck.
  91.   warn "No searching available!\n" unless $con;
  92.   
  93.   return $con;
  94. }
  95.  
  96. my $con;
  97. # Temporary file for retrieved documents
  98. my $tmp = MM->catfile($CPAN::Config->{'cpan_home'}, 'w4c.pod');
  99.  
  100. # run a search
  101. sub wq {
  102.   my $self = shift;
  103.   my $result;
  104.   local ($") = ' ';
  105.  
  106.   $con ||= _open_connection || return;
  107.   print "Searching for '@_'\n";
  108.   unless ($result = $con->search(@_)) {
  109.     print "Your query contains a syntax error.\n";
  110.     $self->wh('wq');
  111.   } else {
  112.     print $con->message;
  113.     print @{$result};
  114.     print "Type 'wr <number>' or 'wd <number>' to examine the results\n";
  115.   }
  116.   $result;
  117. }
  118.  
  119. # display hit record
  120. sub wr {
  121.   my $self = shift;
  122.   my $hit  = shift;
  123.   my $result;
  124.  
  125.   if (@_ or !$hit) {
  126.     print "USAGE: wr <hit-number>\n";
  127.   } else {
  128.     $con ||= _open_connection || return;
  129.     print "fetching info on hit number $hit\n";
  130.     $result = $con->info($hit);
  131.     print @$result;
  132.   }
  133.   $result;
  134. }
  135.  
  136. # display hit document
  137. sub wd {
  138.   my $self = shift;
  139.   my $hit  = shift;
  140.   my $result;
  141.  
  142.   if (@_ or !$hit) {
  143.     print "USAGE: wd <hit-number>\n";
  144.     return;
  145.   } 
  146.   $con ||= _open_connection || return;
  147.   print "Get hit number $hit ...";
  148.   my $text  = $con->get($hit);
  149.   my $lines = ($text)?@$text:'no';
  150.   print " done\nGot $lines lines\nRunning perldoc on it ...\n";
  151.   
  152.   # perldoc does not read STDIN; so we need a temp file
  153.   {
  154.     my $fh = new FileHandle ">$tmp";
  155.     $fh->print(@{$text});
  156.   }
  157.  
  158.   # is system available every were ??
  159.   system $^X, '-S', 'perldoc', $tmp
  160.     and warn "Could not run '$^X -S perldoc $tmp': $?\n"
  161.       and system $Config{'pager'}, $tmp
  162.         and warn "Could not run '$Config{'pager'} $tmp': $?\n"
  163.           and print @$text;
  164.   $text;
  165. }
  166.  
  167. sub wl {
  168.   my $self = shift;
  169.   my $hits = shift;
  170.   
  171.   if (@_) {
  172.     print "USAGE: wl <maximum-hit-count>\n";
  173.     return;
  174.   }
  175.   $con ||= _open_connection || return;
  176.   print "Setting maximum hit count to $hits\n";
  177.   $con->hits($hits);
  178. }
  179.  
  180. my %HELP =
  181.   (
  182.    'h' => q{
  183. 'wh'           displays a short summary of commands available via the WAIT
  184.                plugin.
  185. 'wh <command>' displays information about a the command given as argument
  186.    },
  187.    'q' => q{
  188. Here are some query examples:
  189.  
  190. information retrieval               free text query 
  191. information or retrieval            same as above 
  192. des=information retrieval           `information' must be in the description 
  193. des=(information retrieval)         one of them in description 
  194. des=(information or retrieval)      same as above 
  195. des=(information and retrieval)     both of them in description 
  196. des=(information not retrieval)     `information' in description and
  197.                                     `retrieval' not in description 
  198. des=(information system*)           wild-card search
  199. au=ilia                             author names may be misspelled
  200.  
  201. You can build arbitary boolean combination of the above examples.
  202. The following fields are known: 
  203.  
  204.   'synopsis', 'name', 'bugs', 'author', 'example', 'description',
  205.   'environment'
  206.  
  207. Field names may be abbreviated.
  208. },
  209.    'r' => q{
  210. 'wr <hit-number>'  displays the record of the selected hit. Records look
  211.                    like this:
  212.  
  213.    source          authors/id/CHIPS/perl5.003_24.tar.gz
  214.    headline        perl - Practical Extraction and Report Language 
  215.    size            12786
  216.    docid           data/perl/pod/perl.pod
  217.  
  218. 'source'   is the patch relative to http://www.perl.org/CPAN/.
  219. 'headline' is the contents of the 'NAME' section of the POD document
  220. 'size'     is the size of the POD document (not the size of the tar archive)!
  221. 'docid'    is the path the POS document is stored in. It should be the
  222.            path in the tar archive minus the version number + a 'data'
  223.            prefix.
  224.    },
  225.    'l' => q{
  226. Since answers to queries are sorted by decreasing probability of relevance,
  227. you will probably be interested only in the first few hits. To limit the amout
  228. of network traffic, the WAIT server only returns the best 10 hits per default.
  229. You can change this limit with 'wl <number>'.
  230.    },
  231.    'd' => q{
  232. The 'wd <hit-number>' command retrieves the POD document form the
  233. server and stores it in the file 'w2c' in your CPAN directory. Then it
  234. runs 'perlpod' on it. If you have problems, check if you local
  235. 'perlpod' works with absolute path names. Older versions are know to
  236. fail. Also try to avoid fetching of large documents like 'perlfunc.pod'.
  237. Use 'wr <hit-number>' to see how large the documents are before fetching
  238. the actually if you have a slow connection.
  239. },
  240.  
  241.   );
  242.  
  243. sub wh {
  244.   my $self = shift;
  245.   my $cmd  = shift;
  246.  
  247.   if ($cmd and $cmd =~ /(\w)$/) {
  248.     print $HELP{$1} || "No help for 'w$1' yet.\n";
  249.   } else {
  250.     print qq[
  251. Available commands:
  252. wq        query           search the WAIT4CPAN server
  253. wr        hit-number      display search result record
  254. wd        hit-number      fetch the document and run perldoc on it
  255. wl        count           limit search to <count> hits
  256. wh        command         displays help on command if available
  257. ];
  258.   }
  259.   1;
  260. }
  261.  
  262. END {
  263.   unlink $tmp if -e $tmp;
  264. }
  265.  
  266. 1;
  267.  
  268. __DATA__
  269.  
  270. =head1 NAME
  271.  
  272. CPAN::WAIT - adds commands to search a WAIT4CPAN server to the CPAN C<shell()>
  273.  
  274. =head1 SYNOPSIS
  275.  
  276.   perl -MCPAN -e shell
  277.   > wq au=wall
  278.   > wr 3
  279.   > wd 3
  280.   > wl 20
  281.   > wh
  282.   > wh wq
  283.  
  284. =head1 DESCRIPTION
  285.  
  286. B<CPAN::WAIT> adds some comands to the CPAN C<shell()> to perform
  287. searches on a WAIT server. It connects to a WAIT server using a simple
  288. protocoll resembling NNTP as described in RFC977. It uses the
  289. B<WAIT::Client> module to handle this connection. This in turn
  290. inherits from B<Net::NNTP> from the F<libnet> package. So you need
  291. B<Net::NNTP> to use this module.
  292.  
  293. If no direct connection to the WAIT server is possible, the modules
  294. tries to connect via your HTTP proxy (as given by the CPAN
  295. configuration). Be warned though that the emulation of the stateful
  296. protocol via HTTP is slow.
  297.  
  298. The variable C<CPAN::WAIT::TIMEOUT> specifies the number of seconds to
  299. wait for an answer from the server. The default is 20. You may want to
  300. set it to some larger value if you have a slow connection.
  301.  
  302. The commands available are:
  303.  
  304. =over 
  305.  
  306. =item B<wh> [B<command>]
  307.  
  308. Displays a short help message if called without arguments. If you
  309. provide the name of another command you will get more information on
  310. this command if available. Currently only B<wq> will be explained.
  311.  
  312. =item B<wl> I<count>
  313.  
  314. Limit the number of hits returned in a search to I<count>. The limit
  315. usually is set ot 10 of you don't set it.
  316.  
  317. =item B<wq> I<query>
  318.  
  319. Send a query to the server. 
  320.  
  321. Here are some query examples:
  322.  
  323.   information retrieval               free text query 
  324.   information or retrieval            same as above 
  325.   des=information retrieval           `information' must be in the description 
  326.   des=(information retrieval)         one of them in description 
  327.   des=(information or retrieval)      same as above 
  328.   des=(information and retrieval)     both of them in description 
  329.   des=(information not retrieval)     `information' in description and
  330.                                       `retrieval' not in description 
  331.   des=(information system*)           wild-card search
  332.   au=ilia                             author names may be misspelled
  333.  
  334. You can build arbitary boolean combination of the above examples.
  335. Field names may be abbreviated. For further information see
  336. F<http://ls6-www.informatik.uni-dortmund.de/CPAN>
  337.  
  338. The result should look like this:
  339.  
  340.   wq au=wall
  341.  
  342.    1 8.039 a2p - Awk to Perl translator 
  343.    2 8.039 s2p - Sed to Perl translator 
  344.    3 8.039 perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores) 
  345.    4 8.039 ExtUtils::DynaGlue - Methods for generating Perl extension files 
  346.    5 8.039 h2xs - convert .h C header files to Perl extensions 
  347.    6 8.039 Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls 
  348.    7 8.039 h2ph - convert .h C header files to .ph Perl header files 
  349.    8 8.039 Shell - run shell commands transparently within perl 
  350.    9 8.039 pl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules. 
  351.   10 8.039 perlpod - plain old documentation 
  352.  
  353. =item B<wr> I<hit-number>
  354.  
  355. Display the Record of hit number I<hit-number>:
  356.  
  357.   wr 1
  358.   
  359.   source          authors/id/CHIPS/perl5.003_24.tar.gz
  360.   headline        a2p - Awk to Perl translator 
  361.   size            5643
  362.   docid           data/perl/x2p/a2p.pod
  363.  
  364.  
  365. =item B<wd> I<hit-number>
  366.  
  367. Fetches the full text from the server and runs B<perlpod> on it. Make
  368. sure that you have B<perlpod> in your path. Also check if your
  369. B<perlpod> version can handle absolute pathes. Some older versions
  370. ironically do not find a document if the full patch is given on the
  371. command line.
  372.  
  373. =back
  374.  
  375. =head1 AUTHOR
  376.  
  377. Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
  378.  
  379.