cvs commit: perlfaq/bin postfaq splitfaq

cvsuser     02/07/05 20:33:57

  Added:       bin      postfaq splitfaq
  Log:
  * Chris Fedde created these scripts to post portions of the perlfaq to
  usenet.  i'm taking over that responsibility, so here are the scripts :)
  
  Revision  Changes    Path
  1.1                  perlfaq/bin/postfaq
  
  Index: postfaq
  ===================================================================
  #!/usr/bin/perl
  
  use strict;
  use warnings;
  use File::CounterFile;
  use Mail::Mailer;
  
  my $dir = "$ENV{HOME}/faqs";
  my $counterfile = "$dir/counter";
  my $holdfile    = "$dir/hold_at_zero";
  my $newsgroup = "comp.lang.perl.misc";
  my @faq = <$dir/perlfaq*.txt>;
  
  my $c = new File::CounterFile $counterfile;
  
  $c->lock;
  my $v = $c->value();
  my $i = $v % @faq;
  
  if ($i == 0 and -f $holdfile) {
      send_warning();
      exit 1;
  } 
  
  open(F, ">>$holdfile") or die "$0: can't open flag file: $!";
  close(F);
  
  $c->inc();
  $c->unlock;
  
  my $name = $faq[$i];
  my ($major, $minor) = ($name =~ /(\d+)\.(\d+)/);
  open F, "$name" or die "can't open $name: $!";
  my @text = <F>;
  
  my $subject = $text[0];
  chomp $subject;
  $subject =~ s/^\s+//;
  
  while (<DATA>) {
      last if /^=BREAK/;
      s/(\$\w+)/eval $1/eg;
      print $_;
  } 
  print @text;
  while (<DATA>) {
      s/(\$\w+)/eval $1/eg;
      print $_;
  } 
  
  sub send_warning {
      my $mailer = new Mail::Mailer;
      $mailer->open({
  	To      => '[email protected]',
  	From    => 'PerlFAQ Server <[email protected]>',
  	Subject => 'Holding at Zero',
      });
  
      print $mailer
  	"PerlFAQ Server is holding for clearance before starting\n".
  	"new cycle\n";
  
  } 
  __END__
  From: PerlFAQ Server <[email protected]>
  Newsgroups: $newsgroup
  Subject: FAQ: $subject
  Reply-To: PerlFAQ Server <[email protected]>
  Mail-Copies-To: [email protected]
  
  This message is one of several periodic postings to comp.lang.perl.misc
  intended to make it easier for perl programmers to find answers to
  common questions. The core of this message represents an excerpt
  from the documentation provided with every Standard Distribution of
  Perl.
  
  +
  =BREAK
  - 
  
  Documents such as this have been called "Answers to Frequently
  Asked Questions" or FAQ for short.  They represent an important
  part of the Usenet tradition.  They serve to reduce the volume of
  redundant traffic on a news group by providing quality answers to
  questions that keep coming up.
  
  If you are some how irritated by seeing these postings you are free
  to ignore them or add the sender to your killfile.  If you find
  errors or other problems with these postings please send corrections
  or comments to the posting email address or to the maintainers as
  directed in the perlfaq manual page.
  
  Answers to questions about LOTS of stuff, mostly not related to
  Perl, can be found by pointing your news client to
  
      news:news.answers
  
  or to the many thousands of other useful Usenet news groups.
  
  Note that the FAQ text posted by this server may have been modified
  from that distributed in the stable Perl release.  It may have been
  edited to reflect the additions, changes and corrections provided
  by respondents, reviewers, and critics to previous postings of
  these FAQ. Complete text of these FAQ are available on request.
  
  The perlfaq manual page contains the following copyright notice.
  
    AUTHOR AND COPYRIGHT
  
      Copyright (c) 1997-1999 Tom Christiansen and Nathan
      Torkington.  All rights reserved.
  
  This posting is provided in the hope that it will be useful but
  does not represent a commitment or contract of any kind on the part
  of the contributers, authors or their agents.
  
                                                             $major.$minor
  
  
  
  1.1                  perlfaq/bin/splitfaq
  
  Index: splitfaq
  ===================================================================
  #!/usr/bin/perl
  
  use strict;
  use warnings;
  
  my $dir = "$ENV{HOME}/faqs";
  
  my $skip = 1;
  my $faq;
  my ($major, $minor, $revision, $subject);
  
  $major = 0;
  
  while (<>) {
  
      if (/^perlfaq(\d)*.*Revision/) {
  	chomp;
  	$major = $1;
  	$minor = 0;
  	($revision = $_) =~ s/(?=\()/\n    /;
  	next;
      }
  
      if (/^=head1\s+/) {
  	$skip = 1;
  	next;
      } 
  
      if (/^=head2\s+/) {
  	$skip = 0;
  	if ($faq) {
  	    printfaq();
  	}
  	$faq = $_;
  	$minor++;
  	for ($subject = $_) {
  	    s///;
  	    s/\n/ /g;
  	}
  	next;
      } 
  
      unless ($skip) {
  	$faq .= $_;
      }
  
  }
  
  printfaq();
  
  sub printfaq {
      my $faqname = sprintf("perlfaq.%02d.%02d.txt", $major, $minor);
      print STDERR "$faqname\n";
      open (F, "| pod2text > $dir/$faqname")
  	or die "$0: can't open output";
      print F $faq;
      close F;
  }