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