cvs commit: perlfaq/bin postfaq

cvsuser     02/07/10 22:56:21

  Modified:    bin      postfaq
  Log:
  * reworked the posting mechanism to use Net::NNTP
  
  * Text::Template handles the message creation
  
  * for now, it chooses random answers to post.  i'll think more about that later.
  
  Revision  Changes    Path
  1.2       +53 -81    perlfaq/bin/postfaq
  
  Index: postfaq
  ===================================================================
  RCS file: /cvs/public/perlfaq/bin/postfaq,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -w -r1.1 -r1.2
  --- postfaq	6 Jul 2002 03:33:57 -0000	1.1
  +++ postfaq	11 Jul 2002 05:56:21 -0000	1.2
  @@ -1,82 +1,63 @@
  -#!/usr/bin/perl
  -
  +#!/usr/bin/perl -w
   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',
  +
  +use Net::NNTP;
  +use Text::Template;
  +
  +my $newsgroup = "alt.test";
  +my $email     = '[email protected]';
  +my $dir       = '/home/brian/Dev/perlfaq/faqs';
  +
  +my $template = do { local $/; <DATA> };
  +
  +my @files = glob( "$dir/perlfaq*.txt" );
  +
  +my $file = $files[rand @files];
  +my( $major, $minor ) = $file =~ m/perlfaq.0?(\d).0?(\d+)/g;
  +
  +open my $fh, "$file" or die "Could not open FAQ $file: $!";
  +my $subject = <$fh>;
  +my @body    = <$fh>;
  +$subject =~ s/^\s+|\s+$//g;
  +
  +close $fh;
  +
  +my $message = Text::Template::fill_in_string( $template, HASH =>
  +	{
  +	subject  => $subject,
  +	body     => join( '', @body ),
  +	major    => $major,
  +	minor    => $minor,
       });
   
  -    print $mailer
  -	"PerlFAQ Server is holding for clearance before starting\n".
  -	"new cycle\n";
  +my @message = map { "$_\n" } split /\n/, $message;
   
  -} 
  -__END__
  -From: PerlFAQ Server <[email protected]>
  -Newsgroups: $newsgroup
  -Subject: FAQ: $subject
  -Reply-To: PerlFAQ Server <[email protected]>
  -Mail-Copies-To: [email protected]
  +my @header = (
  +	"Newsgroups: $newsgroup\n",
  +	"Subject: FAQ: $subject\n",
  +	"From: PerlFAQ Server <$email>\n",
  +	);
  +
  +my $nntp = Net::NNTP->new("news.panix.com", DEBUG => 1);
  +$nntp->authinfo( @ENV{ qw(NNTP_USER NNTP_PASS) } );
  +
  +$nntp->postok()                   or die "Posting not allowed \n";
  +$nntp->post( @header, "\n", @message );
  +$nntp->quit;
   
  +__END__
   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.
  +from the documentation provided with Perl.
  +
  +--------------------------------------------------------------------
  +
  +{ "$major.$minor: $subject" }
  +
  +{ $body }
   
  -+
  -=BREAK
  -- 
  +--------------------------------------------------------------------
   
   Documents such as this have been called "Answers to Frequently
   Asked Questions" or FAQ for short.  They represent an important
  @@ -90,13 +71,6 @@
   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
  @@ -113,5 +87,3 @@
   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