home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume31 / pgnews / part01 / pgnews
Text File  |  1992-07-16  |  5KB  |  159 lines
  1. #! /usr/bin/perl
  2. #/****************************************************
  3. #*****************************************************
  4. #**
  5. #** SOURCE NAME | pgnews, (Perl Get News)
  6. #**             | 
  7. #**    SYNOPSIS | pgnews
  8. #**             | 
  9. #** DESCRIPTION | pgnews goes to a specified NNTP server
  10. #**             | and retrieves news articles by newsgroup
  11. #**             | and saves them to a specified file in
  12. #**             | mailbox format.
  13. #**             | Please see the NOTES section.
  14. #**             | 
  15. #**     CHANGES | Programmer:         Date:     Reason/Comments
  16. #**             | Jeffrey B. McGough  09-05-91  initial
  17. #**             | Jeffrey B. McGough  09-06-91  Added select (see FIXES)
  18. #**             | Jeffrey B. McGough  10-06-91  Fixed erronious end of article
  19. #**             | Jeffrey B. McGough  07-09-92  Fixed dup article bug
  20. #**             | 
  21. #**       NOTES | Pgnews needs a file named .pgnews to read
  22. #**             | its newsgroup, last message, and savefile from.
  23. #**             | .pgnews format is:
  24. #**             | newsgroup number savefile
  25. #**             | Example:
  26. #**             | comp.unix.wizards 7800 cuw
  27. #**             | comp.unix.shell 3203 cus
  28. #**             | comp.unix.questions 546 cuq
  29. #**             | 
  30. #**             | comp.unix.wizards will be saved to file cuw in
  31. #**             | mailbox format starting at article 7800 etc.
  32. #**             | 
  33. #**       FIXES | 09-06-91: added select on S to keep the client
  34. #**             | from getting out of sync.
  35. #**             | Jeffrey B. McGough  mcgough@wrdis01.af.mil
  36. #**             | 
  37. #**             | 10-06-91: Fixed an overlooked END of ARTICLE
  38. #**             | bug... Thanks to a member(s) of the issos
  39. #**             | group at Ohio State.
  40. #**             | Jeffrey B. McGough  mcgough@wrdis01.af.mil
  41. #**             | 
  42. #**             | 07-09-92: Fixed a duplicate article bug
  43. #**             | pointed out to me by kenr@bridge.cc.rochester.edu
  44. #**             | and gort@bridge.cc.rochester.edu. Thanks
  45. #**             | for the help with the fix.
  46. #**             | Jeffrey B. McGough  mcgough@wrdis01.af.mil
  47. #**             | 
  48. #****************************************************/
  49.  
  50. require 'sys/socket.ph'; # The way I coded the sockets is this necessary?
  51.  
  52. $port = 119; # For NNTP
  53. # HOSTNAME for the server...
  54. #$host = 'localhost';
  55. $host = 'emory.mathcs.emory.edu';
  56. # Pack format...
  57. $sockaddr = 'S n a4 x8';
  58.  
  59. $DOMAIN = 2;
  60. $STYLE = 1;
  61.  
  62. $newsfile = '.pgnews';
  63. $nnewsfile = '.pgnews.new';
  64.  
  65. $rin = $rout = '';
  66.  
  67. ($name, $aliases, $proto) = getprotobyname('tcp');
  68. ($name, $aliases, $type, $len, $hostaddr) = gethostbyname($host);
  69.  
  70. $sock = pack($sockaddr, $DOMAIN, $port, $hostaddr);
  71.  
  72. socket(S, $DOMAIN, $STYLE, $proto) || die $!;
  73. connect(S, $sock) || die $!;
  74. select(S); $| = 1; select(STDOUT);
  75. #set up for select
  76. vec($rin, fileno(S), 1) = 1;
  77. #this select will block until the server gives us something.
  78. select($rout=$rin, undef, undef, undef);
  79. $_ = <S>; #Read one line to see if we got a good connection.
  80. if ($_ !~ /^2../)
  81. {
  82.     print;
  83.     die "Service unavailable";
  84. }
  85. open(GRP, "< $newsfile") || die "Could not open $newsfile: $!";
  86. open(NGRP, "> $nnewsfile") || die "Could not open $nnewsfile: $!";
  87. select(NGRP); $| = 1; select(STDOUT);
  88. while(<GRP>)
  89. {
  90.     chop;
  91.     ($grp, $lgot, $file) = split;
  92.     print(S "group $grp\n");
  93.     #this select will block until the server gives us something.
  94.     select($rout=$rin, undef, undef, undef);
  95.     $_ = <S>; #Make sure the group change worked...
  96.     ($stat, $num, $first, $last) = split;
  97.     if( $stat !~ /^2../ )
  98.     {
  99.         print;
  100.         warn "Bad group";
  101.         print(NGRP "$grp $lgot $file\n");
  102.         next;
  103.     }
  104.     # good group open output file...
  105.     open(OUTFILE, ">>$file") || die "Could not open $file";
  106.  
  107.     if ( $first > $lgot )
  108.     {
  109.         $lgot = $first;
  110.     }
  111.     if ( $lgot <= $last )
  112.     {
  113.         foreach $art ($lgot..$last)
  114.         {
  115.             print(S "article $art\n");
  116.             #this select will block until the server gives us something.
  117.             select($rout=$rin, undef, undef, undef);
  118.             $_ = <S>; #get error if one exists
  119.             if($_ !~ /^2../)
  120.             {
  121.                 print;
  122.                 warn "No article by that number";
  123.             }
  124.             else
  125.             {
  126.                 do
  127.                 {
  128.                     $lgot = $art;
  129.                     $_ = <S>;
  130.                     s/^Path:/From/;
  131.                     s/\r//;
  132.                     if( $_ ne ".\n")
  133.                     {
  134.                         s/^\.//;
  135.                         print OUTFILE;
  136.                         s/^\./../;
  137.                     }    
  138.                     else
  139.                     {
  140.                         print OUTFILE "\n";
  141.                     }
  142.                 } until $_ eq ".\n";
  143.             }
  144.         }    
  145.     }
  146.     else
  147.     {
  148.         $lgot -= 1;
  149.     }
  150.     close(OUTFILE);
  151.     $lgot += 1;
  152.     print(NGRP "$grp $lgot $file\n");
  153. }
  154. close(NGRP);
  155. close(GRP);
  156. system("mv $nnewsfile $newsfile");
  157. print( S "quit\n");
  158. close(S);
  159.