#!/usr/bin/env perl
my $VERSION = "0.3b";

use Net::NNTP;
use News::Article::Cancel;
use Getopt::Std;
use strict;

# Set with command-line stuff
my $CANCELLER = "tskirvin\@killfile.org"; # Will be blanked in distribution
my $REASON    = "moderator";		
my $SERVER    = $ENV{'NNTPSERVER'} || "news.killfile.org";
my $PORT      = "119";

use vars qw ($opt_h $opt_v $opt_V $opt_T $opt_c $opt_s $opt_t);
$0 =~ s%.*/%%g;		# Trim the path line

getopts ('hvVTt:c:n:');

$CANCELLER = $opt_c if $opt_c;
$REASON    = $opt_t if $opt_t;
$SERVER    = $opt_s if $opt_s;

Usage ()   if $opt_h;
Version () if $opt_v;
Exit ("No reason given for cancel") unless $REASON;
Exit ("No canceller given") unless $CANCELLER;

my $article = News::Article::Cancel->new (\*STDIN);
my $cancel = $article->make_cancel ($CANCELLER, $REASON);

my $NNTP = Net::NNTP->new ($SERVER, 'Port' => $PORT || 119) 
	|| Exit ("Couldn't connect to server $SERVER");

$cancel->write (\*STDOUT) if $opt_V;	
( $cancel->post ($NNTP) && print "Cancel issued to $SERVER\n" ) unless $opt_T;
Exit ();

### Usage ()
# Prints a small help message and exits.

sub Usage {
  warn <<EOM;

$0 v$VERSION
Cancels an article from STDIN.
Usage: $0 [-hTvV] [-t TYPE] [-c CANCELLER] [-s SERVER]

$0 takes a Usenet article from STDIN and cancels it.  

	-h		Prints this message and exits.
	-T		Test mode.  Don't actually post the cancel.
	-v		Print the VERSION number and exit.
	-V		Verbose mode.
	-t TYPE 	Sets the reason for the cancel.  A list of
			  possible values can be found in the News::Cancel 
			  manual page.  Required.
  			Current value: $REASON
	-c CANCELLER 	Sets the email address of the canceller.  Required.
			Current value: $CANCELLER
	-s SERVER	News server to post the cancel to.  Defaults to
			  the environment variable NNTP_SERVER.
EOM
  
  Exit ();
}

### Version
# Prints out the VERSION and exits.

sub Version {
  warn "$0 v$VERSION\n";
  Exit ();
}

### Exit
# Exits the program with the proper error message
my %ErrorCodes = (
	'ERROR'	=>	1,
                 );

sub Exit {
  my ($code, @reason) = @_;
  warn "@reason\n" if @reason;
  exit $ErrorCodes{$code};
}