home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / clip < prev    next >
Encoding:
Text File  |  1992-07-15  |  15.7 KB  |  615 lines
  1. #!/usr/local/bin/perl
  2. 'di';
  3. 'ig00';
  4. #
  5. # $Header: /tmp_mnt/home/netlabs1/lwall/pl/RCS/clip,v 1.1 92/07/13 12:37:09 lwall Exp Locker: lwall $
  6. #
  7. # $Log:    clip,v $
  8. # Revision 1.1  92/07/13  12:37:09  lwall
  9. # Initial revision
  10. # 
  11.  
  12. $HOME = $ENV{HOME}
  13.      || $ENV{LOGDIR}
  14.      || (getpwuid($<))[7]
  15.      || die "No home directory!!!\n";
  16.  
  17. # Configurable parameters, may be overridden in .cliprc
  18.  
  19. $SPOOLDIR = "/usr/spool/news";        # Where news articles are stored.
  20. $NEWSLIB = "/usr/lib/news";        # Where Cnews keeps history file.
  21. $HOMETMP = "$HOME/tmp";            # Where clip should put output.
  22. $HOMEBIN = "$HOME/bin";            # Where clip should install N script.
  23. $MAXLOAD = 3;                # What load average to suspend at.
  24. $NICE = 16;                # What priority to run at.
  25. $DEBUG = 0;                # Whether to be noisy.
  26.  
  27. $CLIPRC = "$HOME/.cliprc";
  28. require $CLIPRC;
  29.  
  30. # Everything from here on should be machine independent.
  31.  
  32. open(N0, "$HOMETMP/n0");
  33. $oldpid = <N0> + 0;
  34. close N0;
  35. if ($oldpid) {
  36.     die "Already a clip process running ($oldpid)\n" if kill 0, $oldpid;
  37. }
  38.  
  39. die "You must call both &NGSKIP and &SCANNER in $CLIPRC\n"
  40.     unless defined &ngskip && defined &scanner;
  41.  
  42. sub fixmsg {
  43.     local($_, $file, $line) = @_;
  44.     $line -= ($Preamble =~ y/\n//);
  45.     s/ file \(eval\) at line (\d+)/" $file at line " .  ($1 + $line)/eg;
  46.     s/ at \(eval\) line (\d+)/" in $file at line " .  ($1 + $line)/eg;
  47.     # $* = 1;s/^/$0: /g; # too noisy to have this
  48.     die;
  49. }
  50.  
  51. sub NGSKIP {
  52.     local($userstuff) = @_;
  53.     if ($userstuff =~ tr/\n// >= 3 && $userstuff !~ /study/) {
  54.     $study = "\t\tstudy;\n";
  55.     }
  56.     else {
  57.     $study = "";
  58.     }
  59.     $eval = (($Preamble = <<'END1' . $study) . $userstuff . <<'END2');
  60.         sub ngskip {
  61.         local($_) = $nglist;
  62.         eval {
  63.             &skip if /^cancelled$/;
  64. END1
  65.         };
  66.         if ($@) {
  67.             $@ = "" if $@ eq "You should never see this\n";
  68.             die $@ if $@;
  69.         }
  70.         }
  71. END2
  72.     print STDERR $eval if $DEBUG & 1;
  73.     eval $eval;
  74.     &fixmsg($@, (caller)[1,2]) if $@;
  75.     1;
  76. }
  77.  
  78. sub SCANNER {
  79.     local($userstuff) = @_;
  80.     $eval = (($Preamble=<<'END1') . $userstuff . <<'END2');
  81.         sub scanner {
  82.         while (<ART>) {
  83.             $totalhits = 0;
  84.             do {
  85.             study;
  86.             $hits = 0;
  87. END1
  88.             $totalhits += $hits;
  89.             } while $hits;
  90.             &printhit if $totalhits;
  91.         }
  92.         }
  93. END2
  94.     print STDERR $eval if $DEBUG & 1;
  95.     eval $eval;
  96.     &fixmsg($@, (caller)[1,2]) if $@;
  97.     1;
  98. }
  99.  
  100. require "timelocal.pl";
  101.  
  102. fork && exit;            # avoid nohup behavior
  103.  
  104. $pid = $$;
  105.  
  106. $pmeter = fork;
  107. defined $pmeter || die "can't fork: $!";
  108. if ($pmeter == 0) {
  109.     &pmeter($MAXLOAD, $pid, $DEBUG & 2);
  110.     die "Not reached";
  111. }
  112.  
  113. if ($HOMEBIN) {
  114.     system "echo kill -HUP $pid >$HOMEBIN/N";
  115.     system "(echo ps $pid; echo ps $pmeter) >$HOMEBIN/P";
  116.     chmod 0755, "$HOMEBIN/N";
  117.     chmod 0755, "$HOMEBIN/P";
  118. }
  119.  
  120. setpriority(0, 0, $NICE);        # set very slow priority
  121.  
  122. $date = shift;
  123. chop($date = `cat $HOME/.lastclip`) if !$date && -f "$HOME/.lastclip";
  124. $date = &lidate($date);
  125.  
  126. chdir $SPOOLDIR || die "Can't cd: $!\n";
  127.  
  128. select(STDERR); $| = 1;
  129. select(STDOUT); $| = 1;
  130.  
  131. &CATCH;
  132. $SIG{HUP} = CATCH;        # send SIGHUP to switch to new history file
  133. $SIG{USR1} = RESTART;        # send SIGUSR1 to re-execute clip
  134. $SIG{ALRM} = IGNORE;        # so we can send ourselves an alarm safely
  135.  
  136. $r = "\r" if -t STDOUT;
  137.  
  138. ($dev,$ino,$mode,$nlink,$uid) = stat STDOUT;
  139. $origuid = $uid;
  140. for (;;) {
  141.   LOGLINE:
  142.     while (<LOG>) {
  143.     $pos = tell(LOG);
  144.     chop;
  145.     ($messid,$date,$nglist) = split(/\t/);
  146.     $0 = "clip at $messid" if $DEBUG & 1;
  147.     $wanted = 1;
  148.     &ngskip;
  149.     next LOGLINE unless $wanted;
  150.     $date = &gidate($date);
  151.     ($ng,$art) = split(m![ /]!,$nglist);
  152.     next unless $art;
  153.     $ng =~ y!.!/!;
  154.     open(ART,"$ng/$art") || next;
  155.     next if -s ART > 100_000;
  156.     $count = 0;
  157.     ++$slept;        # to force quick update after big batch
  158.     $/ = '';
  159.     $header = <ART>;
  160.     $_ = '';
  161.     &scanner;
  162.     close ART;
  163.     $sleep = 5;
  164.     }
  165.     continue {
  166.     $/ = "\n";
  167.     }
  168.     print STDERR "clip: caught up$r\n" unless $tailing++;
  169.     sleep $sleep;
  170.     $slept += $sleep;
  171.     if ($slept > 300) {
  172.     $slept = 0;
  173.     if ($date != $lastdate) {
  174.         ($dev,$ino,$mode,$nlink,$uid,$gid) = stat STDOUT;
  175.         exit unless $uid == $origuid;
  176.         open(LASTDATE,">$HOME/.lastclip");
  177.         print LASTDATE &cdate($date),"\n";
  178.         close LASTDATE;
  179.         $lastdate = $date;
  180.     }
  181.     ($dev,$ino) = stat("$NEWSLIB/history");
  182.     if ($dev != $logdev || $ino != $logino) {
  183.         print STDERR "************* NEW HISTORY FILE *************$r\n";
  184.         open(LOG,"$NEWSLIB/history") || die "Can't open log: $!\n";
  185.         ($logdev, $logino) = stat LOG;
  186.         &seekdate($date);
  187.         $tailing = 0;
  188.         $slept = 300;        # force immediate update of lastclip.
  189.     }
  190.     }
  191.     $sleep++ if $sleep < 120;
  192.     seek(LOG,$pos,0);
  193. }
  194.  
  195. sub hit {
  196.     ($before,$match,$after) = ($`,$&,$');
  197.     $match =~ s/(.)/_\b$1/g;
  198.     $_ = "$before$match$after";
  199.     study;
  200.     $hits++;
  201.     unless ($count++) {
  202.     $header =~ /From: (.*)/;
  203.     ($from = $1) =~ s/.*\((.*)\).*/$1/;
  204.     print("$r\n\@$ng/$art  \tFrom: $from$r\n") || exit;
  205.     $header =~ /Subject: (.*)/ && print "Subject: $1$r\n";
  206.     $0 = "clip " . &cdate($date);
  207.     }
  208. }
  209.  
  210. sub skip {
  211.     $wanted = 0;
  212.     die "You should never see this\n";
  213. }
  214.  
  215. sub printhit {
  216.     if (length() > 500) {
  217.     $wanted = '';
  218.     for ($line = 0; /.*\n/g; $line++) {
  219.         if ($& =~ /_\010/) {
  220.         for ($w = $line - 3; $w <= $line + 3; $w++) {
  221.             vec($wanted,$w,1) = 1;
  222.         }
  223.         }
  224.     }
  225.     $unlines = 0;
  226.     for ($line = 0; /.*\n/g; $line++) {
  227.         if (vec($wanted,$line,1)) {
  228.         print($&,$r) || exit;
  229.         $unlines = 0;
  230.         }
  231.         else {
  232.         print("...\n$r") || exit unless $unlines++;
  233.         }
  234.     }
  235.     }
  236.     else {
  237.     s/\n/\n$r/g if $r;
  238.     print() || exit;
  239.     }
  240. }
  241.  
  242. sub seekdate {
  243.     local($start) = shift;
  244.     if ($start == 9_999_999_999) {
  245.     seek(LOG,0,2);
  246.     $pos = tell(LOG);
  247.     print STDERR "$pid starting at eof...$r\n";
  248.     return;
  249.     }
  250.     ($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
  251.     $st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(LOG);
  252.     for ($offset = $st_size - 100_000; $offset > 0; $offset -= 100_000) {
  253.     if (seek(LOG,$offset,0)) {
  254.         $_ = <LOG>;            # probably starts in middle of a line
  255.         $_ = <LOG>;
  256.         ($messid,$date,$nglist) = split(/\t/);
  257.         $date = &gidate($date);
  258.         last if $date < $start;
  259.     }
  260.     else {
  261.         $offset = -1;
  262.     }
  263.     }
  264.     seek(LOG,0,0) if $offset < 0;
  265.     while (<LOG>) {
  266.     ($messid,$date,$nglist) = split(/\t/);
  267.     $date = &gidate($date);
  268.     last if $date >= $start;
  269.     }
  270.     $pos = tell(LOG);
  271.     $pct = int($pos * 100 / $st_size);
  272.     print STDERR "$pid starting at $pct% for $start...$r\n";
  273.     $0 = "clip start at $messid" if $DEBUG & 1;
  274. }
  275.  
  276. sub CATCH {
  277.     &openout;
  278.     open(LOG,"$NEWSLIB/history") || die "Can't open log: $!\n";
  279.     ($logdev, $logino) = stat LOG;
  280.     $date = 9_999_999_999 unless $date;
  281.     &seekdate($date);
  282.     $tailing = 0;
  283.     $slept = 300;        # force immediate update of lastclip.
  284.     $SIG{HUP} = CATCH;
  285.     kill $$, ALRM;
  286. }
  287.  
  288. sub RESTART {
  289.     kill 9, $pmeter if $pmeter;
  290.     exec "clip";
  291.     die "Couldn't exec clip: $!\n";
  292. }
  293.  
  294. sub cdate {
  295.     ($sec,$min,$hr,$mday,$mon,$year) = localtime($date);
  296.     sprintf("%02d/%02d/%02d %02d:%02d",$mon+1,$mday,$year,$hr,$min);
  297. }
  298.  
  299. sub lidate {
  300.     $_[0] =~ m#(\d+)/(\d+)/(\d+) (\d+):(\d+)#
  301.       ? &timelocal(0, $5, $4, $2, $1-1, $3)
  302.       : $_[0];
  303. }
  304.  
  305. sub gidate {
  306.     $_[0] =~ m#(\d+)/(\d+)/(\d+) (\d+):(\d+)#
  307.       ? &timegm(0, $5, $4, $2, $1-1, $3)
  308.       : $_[0];
  309. }
  310.  
  311. sub openout {
  312.     rename("$HOMETMP/n8", "$HOMETMP/n9");
  313.     rename("$HOMETMP/n7", "$HOMETMP/n8");
  314.     rename("$HOMETMP/n6", "$HOMETMP/n7");
  315.     rename("$HOMETMP/n5", "$HOMETMP/n6");
  316.     rename("$HOMETMP/n4", "$HOMETMP/n5");
  317.     rename("$HOMETMP/n3", "$HOMETMP/n4");
  318.     rename("$HOMETMP/n2", "$HOMETMP/n3");
  319.     rename("$HOMETMP/n1", "$HOMETMP/n2");
  320.     rename("$HOMETMP/n0", "$HOMETMP/n1");
  321.     open(STDOUT, ">$HOMETMP/n0");
  322.     open(STDERR, ">&STDOUT");
  323. }
  324.  
  325. sub pmeter {
  326.     # ($loadavg, $pid, $debug) = @ARGV;
  327.     local($loadavg, $pid, $debug) = @_;
  328.     $running = 1;
  329.     $0 = "pmeter @_";
  330.  
  331.     while (kill 0, $pid) {
  332.     `/usr/ucb/uptime` =~ /load average:\s+([\d.]+)/
  333.         || die "Can't run uptime: $!\n";;
  334.  
  335.     if ($1 > $loadavg) {
  336.         kill 'STOP', $pid;
  337.         if ($running) {
  338.         print STDERR "stopping at $1\r\n" if $debug;
  339.         $0 = "pmeter (stopped $pid at $loadavg)";
  340.         $running = 0;
  341.         }
  342.     }
  343.     else {
  344.         kill 'CONT', $pid;
  345.         if (!$running) {
  346.         print STDERR "starting at $1\r\n" if $debug;
  347.         $0 = "pmeter (started $pid at $loadavg)";
  348.         $running = 1;
  349.         }
  350.     }
  351.     sleep 120;
  352.     }
  353. }
  354. ###############################################################
  355.  
  356.     # These next few lines are legal in both Perl and nroff.
  357.  
  358. .00;                       # finish .ig
  359.  
  360. 'di           \" finish diversion--previous line must be blank
  361. .nr nl 0-1    \" fake up transition to first page again
  362. .nr % 0         \" start at page 1
  363. '; __END__ ##### From here on it's a standard manual page #####
  364.  
  365. .TH CLIP 1 "July 14, 1992"
  366. .de M           \" man page reference
  367. \\fI\\$1\\fR\\|(\\$2\)\\$3
  368. ..
  369. .AT 3
  370. .SH NAME
  371. clip \- personal news clipping service
  372. .br
  373. pmeter \- start and stop a process according to load average
  374. .SH SYNOPSIS
  375. .B clip
  376. [
  377. .I date
  378. ]
  379. .SH DESCRIPTION
  380. .I Newsclip
  381. scans incoming news by following the C news history file as it grows
  382. and examining each article listed there for patterns of interest.
  383. .PP
  384. If a date argument is supplied on the command line (in the form 
  385. .IR "``mm/dd/yy hh:mm''" , 
  386. including the embedded space)
  387. .I clip
  388. will read articles since that date.  With no arguments, it examines
  389. the user's ~/.lastclip file to know when it left off scanning;
  390. if no such file exists, every news article will be scanned.
  391. .PP
  392. Patterns and options are specified in a .cliprc file situated
  393. in your home directory.  The .cliprc file is simply a gob of Perl
  394. code that will be evaluated by clip after it has set its default
  395. options but before it actually goes out to do anything.  The only
  396. mandatory items are a call to each of two subroutines: &NGSKIP and
  397. &SCANNER.  A typical .cliprc file looks like this:
  398. .nf
  399.  
  400. .ne 6
  401.     # Options I want to override.
  402.     $MAXLOAD = 4;
  403.  
  404.     # Newsgroups I always read anyway, so don't bother.
  405.     &NGSKIP( <<'END' );
  406.         &skip if /comp\e.lang\e.perl/;
  407.         &skip if /rec\e.humor\e.funny/;
  408.     END
  409.  
  410. .ne 8
  411.     # Patterns I'm interested in scanning for.
  412.     &SCANNER( <<'END' );
  413.         &hit if /betty[^\e0]boop/i;
  414.         &hit if /roger[^\e0]rabbit/i;
  415.         &hit if /\ebw.*coyote\eb/i;
  416.  
  417.         if (/\ebacme\eb/i) {{
  418.             next if $` =~ /roadrunner\e@$/;
  419.             &hit;
  420.         }}
  421.  
  422.         if (/\eblooney\eb/i) {{
  423.             next if $' =~ /^\es*bin/;
  424.             next if $` =~ /!$/;
  425.             next if $` =~ /fudd\e@/i;
  426.             next if $nglist =~ /alt\e.crazy\e.people/;
  427.             &hit;
  428.         }}
  429.     END
  430.  
  431. .fi
  432. The argument to the &NGSKIP routine is a sequence of zero or more Perl
  433. statements that call &skip if the current article is crossposted to a
  434. newsgroup that we don't want to scan (generally because we'll read the
  435. newsgroup anyway).  Before your code is called, the $_ variable is
  436. automatically set to the list of newsgroups from the history file.
  437. You can invert the logic and just pick the newsgroups you want by
  438. saying:
  439. .nf
  440.  
  441.  
  442. .ne 9
  443.     &NGSKIP(<<'END');
  444.         study;
  445.         {
  446.             last if /comp\e.lang\e.perl/;
  447.             last if /comp\e.org\e.usenix/;
  448.             last if /comp\e.unix\e.bsd/;
  449.             &skip;
  450.         }
  451.     END
  452.  
  453. .fi
  454. .PP
  455. The argument to the &SCANNER routine is a sequence of one or more Perl
  456. statements that call &hit if an interesting pattern has been spotted.
  457. Before your code is called, the $_ variable is set to the current paragraph
  458. of the current article (articles are read and scanned paragraph by paragraph).
  459. Newsclip will snip excerpts from any paragraph containing patterns,
  460. underlining the patterns it found.  Note that some patterns are
  461. unqualified hits, while others are hits only if some other pattern doesn't
  462. match.  (It's important to the underlining algorithm that the value
  463. of $& continue to contain the value of the last 
  464. .I successful
  465. match \(em all
  466. of the exceptions are expected to fail.)  For the purposes of exception
  467. scanning, the variables $` and $' are automatically set to the preceding
  468. and subsequent text by the successful initial pattern match.  In addition,
  469. .I clip 
  470. sets the variable $nglist to the current list of newsgroups, and
  471. the variable $header to be the header of the current article.
  472. .PP
  473. The use of double curlies is merely to allow the ``next'' command to fall
  474. through to the next test, since ``next'' will simply fall out of an ordinary
  475. block.  The ``last'' command could also have been used, but would be less
  476. intuitive.  Other special thingies you might want to use include \eb
  477. to assert a word boundary, [^\e0] to match any character but a null,
  478. including a newline, and any other regular expression goodies you can
  479. think up to detect spelling errors and variants.  Tom Christiansen
  480. searches for his name with:
  481. .nf
  482.  
  483. .ne 4
  484.     if (/\ebtchrist\eb/i || /tom[^\e0]christ(ia|e)ns[eo]n/i) {{ # grr...
  485.         next if /\en\es*Tom Christiansen\es+tchrist\e@convex.com/;
  486.         &hit;
  487.     }}
  488.  
  489. .fi
  490. .PP
  491. .I Newsclip
  492. forks another copy of itself,
  493. called
  494. .IR pmeter ,
  495. which runs 
  496. .M uptime 1
  497. every two minutes to make sure the load hasn't gone too
  498. high.  If it has, 
  499. .I pmeter
  500. suspends 
  501. .I clip 
  502. with a SIGSTOP,
  503. waiting until the load average goes back down before
  504. allowing 
  505. .I clip 
  506. to continue.
  507. Both 
  508. .I pmeter
  509. and 
  510. .I clip
  511. continually
  512. muck with their own externally-visible argument list
  513. to keep folks running
  514. .M ps 1
  515. amused.  This has no effect if your operating system doesn't
  516. support changes to argv being noticed by ps.
  517. .PP
  518. Output by default goes to ~/tmp/n0.  When 
  519. .I clip 
  520. is hit by a SIGHUP,
  521. it renames n8 to n9, n7 to n8, ..., n0 to n1, and creates a new n0
  522. file.  For handiness, when 
  523. .I clip 
  524. starts up, it creates a tiny script
  525. called ``N'' that will send the SIGHUP to the correct process.  Typically
  526. one runs N in the morning to set up a new n0 file, and then reads ~/tmp/n1
  527. to see what the scanner found since the last time you ran N.  A companion
  528. script, named ``P'', runs 
  529. .I ps
  530. on the 
  531. .I clip
  532. and 
  533. .I pmeter
  534. processes.  (This assumes a BSD-style 
  535. .I ps 
  536. program.)
  537. .PP
  538. The first line of each article reference begins with an @, in case you
  539. want to cut and paste that line to something that looks up the article
  540. for you.  I use the following rn macro.  Unfortunately I have to paste
  541. the line twice because of how rn eats typeahead, but hey, it beats a
  542. kick in the head.  This macro should all be on one line \(em it's broken in
  543. two so that nroff doesn't get upset:
  544. .nf
  545.  
  546. .ne 12
  547. @ %(%m=n?:%(%m!=a?q:)q)%(%"^Jng/art: "=\e([^ @]*\e)/\e([^ ]*\e)?
  548. g%`perl -e '($_="%1")=~tr#/#.#;print'`^J.%2^J:%(%m=n?^L:))
  549.  
  550. .fi
  551. .PP
  552. Interesting variables to set in your .cliprc file include the following:
  553. .TP 15
  554. .B $SPOOLDIR
  555. Where news articles are stored; defaults to /usr/spool/news.
  556. .TP 
  557. .B $NEWSLIB 
  558. Where Cnews keeps its history file; defaults to /usr/lib/news.
  559. .TP 
  560. .B $HOMETMP 
  561. Where clip should put its output files;
  562. defaults to ~/tmp.
  563. .TP 
  564. .B $HOMEBIN 
  565. Where clip should install N script;
  566. defaults to ~/bin.
  567. .TP 
  568. .B 
  569. $MAXLOAD 
  570. What load average to suspend at; defaults to 3.
  571. .TP 
  572. .B $NICE 
  573. What priority to run at; defaults to 16.
  574. .TP 
  575. .B $DEBUG
  576. Whether to be noisy; defaults to 0.  A value
  577. with the 1 bit set causes 
  578. .I clip
  579. to be noisy;
  580. a value with the 2 bit set causes
  581. .I pmeter
  582. to be noisy.
  583. .SH ENVIRONMENT
  584. HOME or LOGDIR    
  585. .SH SIGNALS
  586. .nf 
  587. SIGHUP    Cycle log files.
  588. SIGUSR1    Re-exec oneself in case .cliprc changes.
  589. SIGALRM    Make clip wake up early.
  590. .fi
  591. .SH FILES
  592. .nf
  593. .ta \w'$HOME/.cliprc   'u
  594. $HOME/.cliprc    Your clipping preferences.
  595. $HOME/.lastclip    Date and time of last article scanned.
  596. $HOMETMP/n[0-9]    Log files.
  597. $HOMEBIN/N    Cycle log files: n8 -> n9, n7 -> n8, etc.
  598. .fi 
  599. .SH AUTHOR
  600. Larry Wall, with heckling by Tom Christiansen.
  601. .SH "SEE ALSO"
  602. .M perl 1 ,
  603. .M rn 1 ,
  604. .M ps 1 ,
  605. .M uptime 1 ,
  606. .M newsmaint 8 .
  607. .SH DIAGNOSTICS
  608. Obscure diagnostics are an obsolete concept rooted in the notion that
  609. programs must be shoehorned into memory.
  610. .SH BUGS
  611. There ought to be a way for multiple users to share a single clip process.
  612. .PP
  613. It doesn't work on NNTP-only systems.
  614. .ex
  615.