cvs commit: perlfaq/bin postfaq

cvsuser     05/01/06 21:07:30

  Modified:    bin      postfaq
  Log:
  * I refactored most things into subroutines
  
  * I try to be more clever about selecting files to post.  I look for the
  ones with the oldest access times.
  
  Revision  Changes    Path
  1.6       +138 -50   perlfaq/bin/postfaq
  
  Index: postfaq
  ===================================================================
  RCS file: /cvs/public/perlfaq/bin/postfaq,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- postfaq	27 Nov 2004 19:50:32 -0000	1.5
  +++ postfaq	7 Jan 2005 05:07:30 -0000	1.6
  @@ -24,7 +24,7 @@
   	POST_TEMPLATE    the Text::Template file to use
   	NNTP_USER        the NNTP user (if needed)
   	NNTP_PASS        the NNTP password (if needed)
  -
  +	
   This is a sample configuration file:
   
   	SERVER news.example.com
  @@ -79,7 +79,7 @@
   
   =head1 AUTHOR
   
  -brian d foy, [email protected]
  +brian d foy, C<< <[email protected]> >>
   
   =head1 COPYRIGHT
   
  @@ -95,67 +95,155 @@
   use Net::NNTP;
   use Text::Template;
   
  -my $config_file = $ARGV[0] || $ENV{POSTFAQ_CONFIG} || 
  -	File::Spec->catfile( $ENV{HOME}, ".postfaqrc");
  -die "Could not open config file [$config_file]"
  -	unless -e $config_file && -f _ && -r _;
  -	
  -die "Could not open configuration file [$config_file]"
  -	unless -e $config_file && -f _ && -r _;
  -	
  -my $config    = ConfigReader::Simple->new( $config_file );
  -die "Could not parse config file!" unless 
  -	UNIVERSAL::isa( $config, 'ConfigReader::Simple' );
  +my $config                   = get_config( $ARGV[0] );
  +                               check_setup( $config );
  +
  +my $nntp                     = get_nntp( $config );
  +
  +my ( $file, $major, $minor ) = select_faq( $config );
   
  -my $server    = $config->SERVER;	
  -my $newsgroup = $config->GROUP;
  -my $email     = $config->EMAIL;
  +my( $subject, $body )        = get_content( $file );
   
  -my $dir       = $config->FAQ_DIR;
  -die "Could not open faq_dir [$dir]"
  -	unless -e $dir && -d _ && -r _;
   
  -my $template  = $config->POST_TEMPLATE;
  -die "Could not open template [$template]"
  -	unless -e $template && -f _ && -r _;
  +
  +my $message = Text::Template::fill_in_file( 
  +	$config->POST_TEMPLATE,
  +
  +	HASH =>
  +		{
  +		subject  => $subject,
  +		body     => $body,
  +		major    => $major,
  +		minor    => $minor,
  +		} 
  +	);
   	
  -my $nntp_user = $config->NNTP_USER;
  -my $nntp_pass = $config->NNTP_PASS;
  -my $needs_auth = defined $nntp_user || defined $nntp_pass;
   
  -my @files = glob( File::Spec->catfile( $dir, "perlfaq*.txt" ) );
   
  -my $file = $files[rand @files];
  -my( $major, $minor ) = $file =~ m/perlfaq.0?([1-9]).0?(\d+)/g;
  +$subject = "$major.$minor $subject";
  +
  +my @header                   = get_header( $config, $subject );
  +
  +print "@header", "\n", $message;
  +
  +$nntp->post( @header, "\n", split /$/m, $message );
   
  -open my $fh, $file or die "Could not open FAQ $file: $!";
  -my $subject = <$fh>;
  -my @body    = <$fh>;
  -$subject =~ s/^\s+|\s+$//g;
  +$nntp->quit;
   
  -close $fh;
  +# # # # # # # # # # # # # # #
  + # # # # # # # # # # # # # # #
  +# # # # # # # # # # # # # # #
   
  -my $message = Text::Template::fill_in_file( $template, HASH =>
  +sub get_config
   	{
  -	subject  => $subject,
  -	body     => join( '', @body ),
  -	major    => $major,
  -	minor    => $minor,
  -	} );
  +	my $file = shift;
  +	
  +	$file ||= $ENV{POSTFAQ_CONFIG} || 
  +		File::Spec->catfile( $ENV{HOME}, ".postfaqrc");
  +		
  +	die "Could not open config file [$file]"
  +		unless -e $file && -f _ && -r _;
   	
  -my @message = split /$/m, $message;
  +	die "Could not open configuration file [$file]"
  +		unless -e $file && -f _ && -r _;
  +		
  +	my $config    = ConfigReader::Simple->new( $file );
  +	die "Could not parse config file!" unless 
  +		UNIVERSAL::isa( $config, 'ConfigReader::Simple' );	
  +		
  +	$config;	
  +	}
   
  -my @header = (
  -	"Newsgroups: $newsgroup\n",
  -	"Subject: FAQ $major.$minor: $subject\n",
  -	"From: PerlFAQ Server <$email>\n",
  -	);
  +sub check_setup
  +	{
  +	my $config = shift;
  +	
  +	die "Could not open faq_dir [" . $config->FAQ_DIR . "]"
  +		unless check_dir( $config->FAQ_DIR );
  +	
  +	die "Could not open template [" . $config->POST_TEMPLATE . "]"
  +		unless check_file( $config->POST_TEMPLATE );
   
  -my $nntp = Net::NNTP->new( $server );
  -$nntp->authinfo( $nntp_user, $nntp_pass ) if $needs_auth;
  +	die "Could not open history [" . $config->HISTORY . "]"
  +		unless check_file( $config->POST_TEMPLATE );
  +	}
   
  -$nntp->postok() or die "Posting not allowed \n";
  +sub get_nntp
  +	{
  +	my $config = shift;
  +	
  +	my $nntp = Net::NNTP->new( $config->SERVER );
  +	$nntp->postok() or die "Posting not allowed \n";
  +	$nntp->authinfo( $config->NNTP_USER, $config->NNTP_PASS ) 
  +		if defined $config->NNTP_USER || defined $config->NNTP_PASS;
  +	
  +	$nntp;
  +	}
  +	
  +sub check_file
  +	{
  +	my $file = shift;
  +	
  +	die "Could not read [$file]" unless -r $file;
  +	}
  +	
  +sub check_dir
  +	{
  +	my $dir = shift;
  +	
  +	die "Directory does not exist [$dir]" unless -d $dir;
  +	}
  +	
  +sub select_faq
  +	{
  +	my $config = shift;
  +	
  +	my @files = get_files( $config );
  +	
  +	my $file = $files[rand @files];
  +	utime time, time, $file;
  +	
  +	my( $major, $minor ) = $file =~ m/perlfaq.0?([1-9]).0?(\d+).txt$/g;
  +	
  +	( $file, $major, $minor );
  +	}
   
  -$nntp->post( @header, "\n", @message );
  +sub get_files
  +	{
  +	my $config = shift;
  +	
  +	my $time  = 0;
  +	
  +	my @files =
  +		map  { $_->[0] }
  +		grep { $time ||= $_->[1]; $_->[1] == $time }
  +		sort { $b->[1] <=> $a->[1] }
  +		map  { [ $_, -A $_ ] }
  +		glob( File::Spec->catfile( $config->FAQ_DIR, "perlfaq*.txt" ) ); 
   
  -$nntp->quit;
  +	@files;
  +	}
  +	
  +sub get_content
  +	{
  +	my $file = shift;
  +	
  +	open my $fh, $file or die "Could not open FAQ [$file]: $!";
  +	my $subject = <$fh>;
  +	my $body    = join "", <$fh>;
  +	$subject =~ s/^\s+|\s+$//g;
  +	
  +	( $subject, $body )
  +	}
  +	
  +sub get_header
  +	{
  +	my $config  = shift;
  +	my $subject = shift;
  +	
  +	my @header = map "$_\n", (
  +		"Newsgroups: " . $config->GROUP,
  +		"Subject: FAQ $subject",
  +		"From: PerlFAQ Server <" . $config->EMAIL . ">",
  +		);
  +	}