home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 1 / 1073 / narc.pl
Encoding:
Perl Script  |  1990-12-28  |  6.5 KB  |  281 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # $Source: /repousr/u/rae/src/TEXT/perl/RCS/narc.pl,v $
  4. # $Revision: 2.0 $
  5. # $Author: rae $
  6. # $Date: 90/03/25 15:43:00 $
  7.  
  8. # narc -- News ARChiver
  9.  
  10. # to avoid the buffering problems
  11. #
  12. $| = 0;
  13.  
  14. # Check for a NARCRC environment variable and use it if
  15. # it's there.
  16. #
  17. if($ENV{'NARCRC'})
  18.     {
  19.     $narcrc = $ENV{'NARCRC'};
  20.  
  21.     # if NARCRC doesn't start with a '/', prepend
  22.     # $HOME to it
  23.     #
  24.     if($narcrc !~ /\/.*/)
  25.         {
  26.         $narcrc = $ENV{"HOME"} . "/" . $narcrc;
  27.         }
  28.     }
  29. else
  30.     {
  31.     # Default NARCRC: "$HOME/.narcrc"
  32.     #
  33.     $narcrc = $ENV{'HOME'} . "/.narcrc";
  34.     }
  35.  
  36. # testing flag. Usually zero.
  37. #
  38. $verbose=0;
  39. $standalone = "stand";
  40.  
  41. # get the name of the news server.  Can be replaced with
  42. # a hardcoded '$server=machine;' if you like
  43. #
  44. $server_file = "/usr/local/lib/news/server";
  45. $server = `cat $server_file` || die "Can't open $server_file";
  46. chop $server;
  47.  
  48. # Where to find nntp
  49. #
  50. $nntp = "/usr/local/bin/nntp $server";
  51.  
  52. # open narcrc for input.  The format is:
  53. #
  54. #    /full/path/to/archive/directory
  55. #    dirname   newsgroup   last-time-of-access
  56. #    dirname   newsgroup   last-time-of-access
  57. #    dirname   newsgroup   last-time-of-access
  58. #     ...
  59. #
  60. # 'dirname' is appended to the initial path.  The special
  61. # case dirname of 'default' will use the last element of
  62. # the newsgroup name.  For example, 
  63. #    default  comp.sources.unix  19900101 000000
  64. # will use the dirname 'unix'
  65.  
  66. open(NARCRC, "<$narcrc");
  67. $SIG{'INT'} = 'handler';
  68. $SIG{'QUIT'} = 'handler';
  69.  
  70. # The first line of the narcrc is where to store everythign
  71. #
  72. $repo = <NARCRC>;
  73. chop($repo);
  74. print "Saving files in $repo\n" if $verbose;
  75.  
  76. # $narc_line[$narc_index] is where each new line of the narcrc is
  77. # stored .  This only gets written out after a successful 'narc'.
  78. #
  79. $narc_index = 1;
  80.  
  81. # for each line in the narcrc
  82. #    chop it into separate bits
  83. #    ask nntp for all new news for the group
  84. #    for each new news item
  85. #        read article into /tmp/narc$$
  86. #        scan for magic string 'Archive-name'
  87. #        get the subdir and part-name from this line
  88. #    if hit eof, then no magic string was found, do next news item
  89. #    create all leading directories if they're not there already
  90. #    move /tmp/narc$$ to full pathname of archived article
  91. while($narc_entry = <NARCRC>)
  92.     {
  93.     chop($narc_entry);
  94.  
  95.     # This is a software end-of-file because I am having trouble with
  96.     # garbage showing up at the ends of file.  With shar files it's
  97.     # not such a big deal, since they usually have 'exit 0' at the end
  98.     # of them, but with the .narcrc, it might be accidentally parsed.
  99.     #
  100.     last if($narc_entry eq "EOF");
  101.  
  102.     ($real_dirname, $newsgroup, $lastdate, $lasttime) = split(' ', $narc_entry);
  103.  
  104.     # check for degenerate empty case
  105.     #    
  106.     last if $newsgroup eq "" || $lastdate eq "" || $lasttime eq "";
  107.  
  108.     # if "default", set dirname to last element
  109.     # of the newsgroup name
  110.     #
  111.     if($real_dirname eq "default" && $newsgroup =~ /.*\.([^.]*)$/)
  112.         {
  113.         $dirname = $1;
  114.         }
  115.     else
  116.         {
  117.         $dirname = $real_dirname;
  118.         }
  119.  
  120.     # tell the user what's going on
  121.     #
  122.     "$lastdate $lasttime" =~ /^(..)(..)(..) (..)(..)(..)$/ &&
  123.         printf("%s %s 19%s-%s-%s %s:%s\n",
  124.             $newsgroup, "[$dirname]", $1, $2, $3, $4, $5);
  125.  
  126.     # open the stdout of the nntp command
  127.     #
  128.     open(MSGIDS, "$nntp newnews $newsgroup $lastdate $lasttime|")
  129.         || die "Can't get message ID's for $newsgroup from $server";
  130.  
  131.     # flag to see if we do anything
  132.     $we_did_something = 0;
  133.  
  134.     # for each message ID..
  135.     #
  136.     while($msgid = <MSGIDS>)
  137.         {
  138.         # set the we_did_something flag so we know to update
  139.         # the narcrc
  140.         #
  141.         $we_did_something = 1;
  142.  
  143.         # Zap the trailing newline on $msgid
  144.         #
  145.         chop($msgid);
  146.         print "\t$msgid\n" if $verbose;
  147.  
  148.         # Get the article and store it in /tmp so we don't
  149.         # need to use multiple [slow] nntp's for the same article
  150.         #
  151.         system("$nntp article '$msgid' > /tmp/narc$$");
  152.  
  153.         # Open the article and check for "Archive-name"
  154.         #
  155.          open(BODY, "</tmp/narc$$") || die "Can't read retrieved article $msgid in file /tmp/narc$$";
  156.         while(<BODY>)
  157.             {
  158.             if(/^Archive-name:/)
  159.                 {
  160.                 ($foo, $arc_name) = split;
  161.                 @tree = split('/', $arc_name);
  162.                 # Put it in the '$standalone' dir if it's a single shar
  163.                 unshift(tree, $standalone)    if $#tree == 0;
  164.                 print "\t", join('/', @tree), "\n";
  165.                 last;
  166.                 } #if Archive-name
  167.             } # while BODY
  168.  
  169.         # if eof then "Archive-name" wasn't found
  170.         #
  171.         last if eof;
  172.  
  173.         # close the file
  174.         #
  175.         close(<BODY>);
  176.  
  177.         # Now build the full pathname of where the file is
  178.         # supposed to live
  179.         $fullpath = $repo . '/' . $dirname . '/' . join('/', @tree);
  180.         $name = pop(@tree);
  181.         $relpath = $dirname . '/' . join('/', @tree);
  182.  
  183.         # make sure the dirs are there
  184.         #
  185.         &mkpath($repo . '/' . $dirname . '/' . join('/', @tree));
  186.  
  187.         if(-f $fullpath)
  188.             {
  189.             # A copy of the file already exists, so name this one the
  190.             # same as the existing one, but with a number appended to
  191.             # it to delineate its version.
  192.             #
  193.             for($i=2; -f $fullpath . $i; $i++)
  194.                 { }
  195.  
  196.             # tack the number onto the end of the file name
  197.             #
  198.             $fullpath .= $i;
  199.             }
  200.  
  201.         # and finally, put it there
  202.         system("mv /tmp/narc$$ $fullpath");
  203.  
  204.         } # while MSGIDS
  205.     close(<MSGIDS>);
  206.  
  207.     # only update the timestamp if we did anything
  208.     #
  209.     $timestamp = $we_did_something ? &now() : "$lastdate $lasttime";
  210.  
  211.     # Save the narcrc lines in memory in order so we can save them in
  212.     # their original order.  Just using 'each' on %NARCRC currently
  213.     # inverts their order [as of Perl 3.0]
  214.     #
  215.     $narc_line[$narc_index++] = sprintf("%s\t%s\t%s", $real_dirname, $newsgroup, $timestamp);
  216.     } # while narc_entry
  217. close(<NARCRC>);
  218.  
  219. # Save an updated narcrc
  220. #
  221. print "Saving $narcrc..";
  222. open(NARCRC, ">$narcrc");
  223. print NARCRC $repo, "\n";
  224. for($i=1; $i < $narc_index; $i++)
  225.     {
  226.     print NARCRC $narc_line[$i], "\n";
  227.     }
  228. # software EOF
  229. print NARCRC "EOF\n";
  230. close(<NARCRC>);
  231. print "\n";
  232.  
  233. # Subroutine to return the current date and time in
  234. # nntp format, which is "YYMMDD HHMMSS"
  235. #
  236. sub now
  237.     {
  238.     ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time());
  239.     $mon++;
  240.     sprintf("%02d%02d%02d %02d%02d%02d", $year,$mon,$mday,$hour,$min,$sec);
  241.     }
  242.  
  243. sub handler
  244.     {
  245.     local($sig) = @_;
  246.     print "\n\nCaught signal $sig -- exiting $ARGV[0]\n";
  247.     close(<ARTICLE>);
  248.     close(<BODY>);
  249.     close(<MSGIDS>);
  250.     close(<NARCRC>);
  251.     close(<SAVEFILE>);
  252.     exit 0;
  253.     }
  254.  
  255. sub mkpath
  256.     {
  257.     local($fullpath) = @_;
  258.     local(@tree) = split('/', $fullpath);
  259.     local(@tmp) = ();
  260.  
  261.     if($tree[0] eq "")
  262.         {
  263.         push(@tmp, shift(@tree));
  264.         }
  265.     foreach $dir (@tree)
  266.         {
  267.         push(@tmp, $dir);
  268.         $path = join('/', @tmp);
  269.         print "\t%% checking for '$path'\n" if $verbose;
  270.         mkdir("$path", 0777) || die "Can't create directory $path"
  271.             if ! -d "$path";
  272.         }
  273.     }    
  274.  
  275. # Emacs cutsomisation
  276. #
  277. # Local Variables:
  278. # mode:fundamental
  279. # tab-width:4
  280. # End:
  281.