#!/usr/bin/perl 
# Perlbug historical data or archive processor 
# (C) 1999 Richard Foley RFI perlbug@rfi.net 
# $Id: bughist,v 1.8 2001/10/19 12:40:21 richardf Exp $
#

use strict;
use vars(qw($VERSION));
$VERSION = do { my @r = (q$Revision: 1.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; 

=head1 NAME

HIST - historical perlbug data processor

=head1 DESCRIPTION

Loops through all files in a given directory, looking for a potential mail message for entry, or otherwise in the perlbug database.

=head1 USAGE

	./bughist -[deEhmqrvt] -i input_file_or_dir

=cut

my $usage = qq|Usage: $0 -[ehmqrvt] -i input_file_or_dir
See also: 'perldoc $0'
|;

use Carp; 
use Data::Dumper;
use FindBin;
use lib "$FindBin::Bin/..";
use Getopt::Std; 
use IO::File;
use Mail::Internet;
use Perlbug::Interface::Email; 

my $o_pb = Perlbug::Interface::Email->new;

my $i_fnd	= 0;
my $i_cnt	= 0;
my $i_nr    = 0;
my %dir  	= ();

=head1 SWITCHES

=item d

debug level

=item e

email switch (1=notify p5p, 0=don't:default)

=item E

Email a notification of any input - B<no> data in DB and sets B<e=1> and B<t=0>

=item h

help - perldoc $0

=item i

input file or directory name

=item m

max number of files to process

=item q

quiet

=item r

recurse through deeper directories, default action is non-recurse

=item t

test (no mails sent, instead output echoed to STDOUT)

=item v

offer feedback on switch <- subject, to, x-perlbug, etc

=cut

# ARGs
my %arg = (
	'd'	=> 0,   # debug
	'e'	=> 0,	# email (default is no email - just db ops)
	'E'	=> 0,	# re-notify (overrides and sets e=1, t=0)
	'h' => 0, 	# help
	'i' => '',	# dir
	'm'	=> 101, # max
	'q'	=> 0, 	# quiet
	'r'	=> 0,	# recurse (if dir)
	't' => 0, 	# test 
	'v' => 0, 	# verbose 
);
getopts('d:eEhi:m:qrtv', \%arg);
use vars(qw($d $e $E $h $i $m $q $r $t $v));
foreach my $switch (keys %arg) {
	no strict 'refs';
	$$switch = $arg{$switch};
}
if ($E) { $e = 1; }
$o_pb->current({'debug'		=> $d});
$o_pb->current({'isatest'	=> $t});
$o_pb->current({'renotify'	=> $E});
$o_pb->current({'mailing'	=> $e}); 

# Process 
# -----------------------------------------------------------------------------
if (!($h == 0 || $i =~ /\w+/)) {
	print $usage;
	exit;
} 

my $i_ok = &input($i);
if ($v) {
	print "found($i_fnd) processed($i_cnt) <$i_nr> of max($m)\n";
	print "output: ".Dumper(\%dir) if $d;
}
$o_pb->clean_up("$0 -> ($i_ok)");
exit;


=head1 FUNCTIONS

Internal function calls


=item input

Act upon input data

	my $i_ok = &input($input_fileordirname);

=cut

sub input {
	my $input = shift;
	my $i_ok  = 0;
	if ($input !~ /\w+/) {
		confess("Invalid input($input): $! \n$usage");
	} else {
		$i_ok = (-d $input) ? dir($input) : process($input);
	}
	return $i_ok;
}


=item dir

Loop through directory calling L<dir> or L<process>

	my $i_ok = &dir($input);

=cut 

sub dir {
	my $dir = shift;
	$dir{$dir} = {};
	my $i_dircnt = 0;
	my $i_ok = 0;
	print "Opening dir($dir)\n" if $v;
	if(!(opendir(DIR, $dir))) {
		confess("Can't open dir($dir): $!");
	} else {
		my @items = grep{ /\w+/ && "$dir/$_" } readdir(DIR);
		close DIR;
		$dir{$dir} = scalar(@items); # ref
		if (@items >= 1) { 
			print "Found [".@items."] items in dir($dir)\n" if $v;
			ITEM:
			foreach my $item (@items) {
				if ($i_cnt >= $m) {
					print "Passed maximum($m) object count($i_cnt)\n";
					exit; 
					last ITEM; # control it
				}
				$i_dircnt++;
				$item = $dir.'/'.$item;
				if (-d $item) {
					next ITEM unless $r;
					$i_ok = &dir($item);
				} else {
					$i_ok = &process($item);
				}
			}
		}
	}
	return $i_ok;
}


=item process 

Process each file given as an historical message with no mailing enabled.

	my $i_ok = &process($file);

=cut

sub process {
	my $file = shift;
	$i_ok 	 = 0;
	$i_cnt++;
	if (!($file =~ /\w+/ && -f $file && -r _)) {
		confess("FILE($file) invalid: $!");
	} else {
		my $star = '';
		print "Opening file($file)\n" if $v;
		my $FH = IO::File->new;
		if (!(open($FH, $file))) {
			carp("Can't open file($file): $!");
		} else {
			my $o_int = Mail::Internet->new($FH);
			close $FH;
			print "inspecting mail...\n";
			my $h_cmds = $o_pb->parse_input($o_int);
			my ($meth) = keys %{$h_cmds};
			if (grep(/new|reply|B|E|M|N|P|T/, keys %{$h_cmds})) {
				$star = '*';
				$i_nr++;
			}
			my @res = $o_pb->process_commands($h_cmds, $o_int);
			undef $o_int;
			print "[$i_cnt] <$i_nr> -> ".substr("${meth}$star", 0, 9)." -> ok($i_ok)\n" unless $q;
			if (ref($$h_cmds{$meth}) eq 'HASH') {
				unless ($v) {
					$$h_cmds{$meth}{'body'}   = 'trimmed';
					$$h_cmds{$meth}{'header'} = 'trimmed';
				}
			} 	
			print "[$i_cnt] $file($meth): ".Dumper($h_cmds) unless $q;
		}
	}
	return $i_ok;
}

#
