# HtagPlugin.pm
# (C) Copyright 2000-2001 Simon Huggins <huggie@earth.li>

# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2 of the License, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc., 59
# Temple Place, Suite 330, Boston, MA 02111-1307  USA

package HtagPlugin;

use vars qw($VERSION %cfg);
use Carp;

# This version is the version of this module and not  the version of htag.
# Plugins using functions only in new modules should really check the
# version.
$VERSION = '0.5';

# Do magic exporter stuff per mjd
sub import {
	my $caller = caller;  

	*{$caller . '::nicedie'} 		= \&nicedie;
	*{$caller . '::subst_macros'} 		= \&subst_macros;
	*{$caller . '::process_msgbody'}	= \&process_msgbody;
	*{$caller . '::cfg'} 			= \%cfg;
	*{$caller . '::scansigfile'}		= \&scansigfile;
	*{$caller . '::chunksizealign'}		= \&chunksizealign;
	*{$caller . '::reg_deletion'} 		= \&reg_deletion;
	*{$caller . '::delete_tmpfiles'} 	= \&delete_tmpfiles;
}

sub nicedie($) {
	my $msg = shift;
	warn $msg;
	if ($cfg{'nicedie'}) {
		warn "Press <RETURN> to continue\n";
		my $throwaway=<STDIN>;
	}
# not die for the case when it's a plugin that calls this from the eval
	exit;
}


sub subst_macros($) {
	my $text=shift;

	if (defined $cfg{'fname'}) { $text =~ s/\@F/$cfg{'fname'}/g; }
	if (defined $cfg{'name'})  { $text =~ s/\@N/$cfg{'name'}/g;  }
	if (defined $cfg{'lname'}) { $text =~ s/\@L/$cfg{'lname'}/g; }

	$text =~ s/\@B/\n/g;
	$text =~ s/\@V/$cfg{'VERSION'}/g;

	return $text;
}

sub assign_names($) {
	my $match = shift;
	if ($match =~ /^(.*), (.*)$/) {
		$match = "$2 $1";
	}
	$cfg{'fname'} = $cfg{'name'} = $cfg{'lname'} =  $match;
	if ($cfg{'name'} =~ /\s/) {
		$cfg{'fname'} =~ s/^([^ ]+)\s.*/$1/;
		$cfg{'lname'} =~ s/.*\s([^ ]+)$/$1/;
	}
}

sub process_msgbody($) {
	my $msgfile = shift;
	if ($msgfile ne "-") {
		open(HANDLE,$msgfile)
			or nicedie "$0: Cannot open $msgfile: $!\n";
		while (<HANDLE>) {
			if (/^To:\s+\"?([^"']*)\"?\s+\<.*\>$/) {
				# To: "anything here" <address>
				assign_names($1);
				last;
			} elsif (/^To:\s+[a-zA-Z_.-]+\@[a-zA-Z.-]+\s+\((.*)\)$/) {
				# To: me@here.com (Blah)
				assign_names($1);
				last;
			} elsif (/^$/) { # end of headers
				last;
			}
		}
		close(HANDLE);
	}
}

# Scan the sigfile for the character passed looking for @X[0-9][RC]?@ where
# X is the argument.
# Return LoL of what found, size, align.

sub scansigfile($) {
	my (@found,$sig);
	my $char = shift;

	if (length $char > 1) {
		nicedie "You passed $char to scansigfile!  Must only be one character";
	}

	open(SIG, "<$cfg{'tmpsigfile'}")
		or nicedie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
	while(<SIG>) {
		$sig .= $_;
	}
	close(SIG);

	while ($sig =~ s/(\@$char([1-9][0-9]*)([RC])?@)//) {
		my @array = ($1,$2);
		push @array, defined($3) ? $3 : "L";
		push @found, \@array;
	}
	
	return @found;
}

sub chunksizealign($$$) {
	my ($chunk,$size,$align) = @_;

	if (defined $align and $align eq 'R') {		# Right
		$chunk=sprintf("%$size" . "s",$chunk);
	} elsif (defined $align and $align eq 'C') {	# Centered
		# There must be a better way to do this...
		my ($lspc,$rspc);
		$lspc=(($size - length($chunk))/2);

		### Repeat after me thou shalt not use = when thou meanest ==
		if (not $lspc == int($lspc)) { # Odd number of chars.
			$rspc=" " x ($lspc + 1);
		} else {
			$rspc=" " x $lspc;
		}
		$lspc=" " x $lspc;
		$chunk=$lspc . $chunk . $rspc;
	} else {
		$chunk=sprintf("%-$size" . "s",$chunk);	# Left
	}

}

{
my %delete;

sub reg_deletion($) {
	my $file = shift;
	$delete{$file}++;
}

sub delete_tmpfiles() {
	return if not %delete;
	foreach (keys %delete) {
		unlink if -f;
	}
}
}


1;
