2 # (C) Copyright 2000-2003 Simon Huggins <huggie@earth.li>
4 # This program is free software; you can redistribute it and/or modify it
5 # under the terms of the GNU General Public License as published by the Free
6 # Software Foundation; either version 2 of the License, or (at your option)
9 # This program is distributed in the hope that it will be useful, but
10 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 # You should have received a copy of the GNU General Public License along
15 # with this program; if not, write to the Free Software Foundation, Inc., 59
16 # Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 use vars qw($VERSION %cfg);
23 # This version is the version of this module and not the version of htag.
24 # Plugins using functions only in new modules should really check the
28 # Do magic exporter stuff per mjd
32 *{$caller . '::nicedie'} = \&nicedie;
33 *{$caller . '::subst_macros'} = \&subst_macros;
34 *{$caller . '::process_msgbody'} = \&process_msgbody;
35 *{$caller . '::cfg'} = \%cfg;
36 *{$caller . '::scansigfile'} = \&scansigfile;
37 *{$caller . '::chunksizealign'} = \&chunksizealign;
38 *{$caller . '::reg_deletion'} = \®_deletion;
39 *{$caller . '::delete_tmpfiles'} = \&delete_tmpfiles;
45 if ($cfg{'nicedie'}) {
46 warn "Press <RETURN> to continue\n";
47 my $throwaway=<STDIN>;
49 # not die for the case when it's a plugin that calls this from the eval
57 if (defined $cfg{'fname'}) { $text =~ s/\@F/$cfg{'fname'}/g; }
58 if (defined $cfg{'name'}) { $text =~ s/\@N/$cfg{'name'}/g; }
59 if (defined $cfg{'lname'}) { $text =~ s/\@L/$cfg{'lname'}/g; }
62 $text =~ s/\@V/$cfg{'VERSION'}/g;
69 if ($match =~ /^(.*), (.*)$/) {
72 $cfg{'fname'} = $cfg{'name'} = $cfg{'lname'} = $match;
73 if ($cfg{'name'} =~ /\s/) {
74 $cfg{'fname'} =~ s/^([^ ]+)\s.*/$1/;
75 $cfg{'lname'} =~ s/.*\s([^ ]+)$/$1/;
79 sub process_msgbody($) {
81 if ($msgfile ne "-") {
83 or nicedie "$0: Cannot open $msgfile: $!\n";
85 if (/^To:\s+\"?([^"']*)\"?\s+\<.*\>$/) {
86 # To: "anything here" <address>
89 } elsif (/^To:\s+[a-zA-Z_.-]+\@[a-zA-Z.-]+\s+\((.*)\)$/) {
90 # To: me@here.com (Blah)
93 } elsif (/^$/) { # end of headers
101 # Scan the sigfile for the character passed looking for @X[0-9][RC]?@ where
103 # Return LoL of what found, size, align.
109 if (length $char > 1) {
110 nicedie "You passed $char to scansigfile! Must only be one character";
113 open(SIG, "<$cfg{'tmpsigfile'}")
114 or nicedie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
120 while ($sig =~ s/(\@$char(\*|(?:[1-9][0-9]*))([RC]?)\@)//) {
122 push @array, defined($3) ? $3 : "L";
123 push @found, \@array;
129 sub chunksizealign($$$) {
130 my ($chunk,$size,$align) = @_;
132 if (defined $align and $align eq 'R') { # Right
133 $chunk=sprintf("%$size" . "s",$chunk);
134 } elsif (defined $align and $align eq 'C') { # Centered
135 # There must be a better way to do this...
137 $lspc=(($size - length($chunk))/2);
139 ### Repeat after me thou shalt not use = when thou meanest ==
140 if (not $lspc == int($lspc)) { # Odd number of chars.
141 $rspc=" " x ($lspc + 1);
146 $chunk=$lspc . $chunk . $rspc;
148 $chunk=sprintf("%-$size" . "s",$chunk); # Left
156 sub reg_deletion($) {
161 sub delete_tmpfiles() {
162 return if not %delete;
163 foreach (keys %delete) {