HtagPlugin/HtagPlugin.pm

   1 # HtagPlugin.pm
   2 # (C) Copyright 2000-2001 Simon Huggins <huggie@earth.li>
   3
   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)
   7 # any later version.
   8 #
   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
  12 # for more details.
  13 #
  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
  17
  18 package HtagPlugin;
  19
  20 use vars qw($VERSION %cfg);
  21 use Carp;
  22
  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
  25 # version.
  26 $VERSION = '0.5';
  27
  28 # Do magic exporter stuff per mjd
  29 sub import {
  30         my $caller = caller;
  31
  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'}           = \&reg_deletion;
  39         *{$caller . '::delete_tmpfiles'}        = \&delete_tmpfiles;
  40 }
  41
  42 sub nicedie($) {
  43         my $msg = shift;
  44         warn $msg;
  45         if ($cfg{'nicedie'}) {
  46                 warn "Press <RETURN> to continue\n";
  47                 my $throwaway=<STDIN>;
  48         }
  49 # not die for the case when it's a plugin that calls this from the eval
  50         exit;
  51 }
  52
  53
  54 sub subst_macros($) {
  55         my $text=shift;
  56
  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; }
  60
  61         $text =~ s/\@B/\n/g;
  62         $text =~ s/\@V/$cfg{'VERSION'}/g;
  63
  64         return $text;
  65 }
  66
  67 sub assign_names($) {
  68         my $match = shift;
  69         if ($match =~ /^(.*), (.*)$/) {
  70                 $match = "$2 $1";
  71         }
  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/;
  76         }
  77 }
  78
  79 sub process_msgbody($) {
  80         my $msgfile = shift;
  81         if ($msgfile ne "-") {
  82                 open(HANDLE,$msgfile)
  83                         or nicedie "$0: Cannot open $msgfile: $!\n";
  84                 while (<HANDLE>) {
  85                         if (/^To:\s+\"?([^"']*)\"?\s+\<.*\>$/) {
  86                                 # To: "anything here" <address>
  87                                 assign_names($1);
  88                                 last;
  89                         } elsif (/^To:\s+[a-zA-Z_.-]+\@[a-zA-Z.-]+\s+\((.*)\)$/) {
  90                                 # To: me@here.com (Blah)
  91                                 assign_names($1);
  92                                 last;
  93                         } elsif (/^$/) { # end of headers
  94                                 last;
  95                         }
  96                 }
  97                 close(HANDLE);
  98         }
  99 }
 100
 101 # Scan the sigfile for the character passed looking for @X[0-9][RC]?@ where
 102 # X is the argument.
 103 # Return LoL of what found, size, align.
 104
 105 sub scansigfile($) {
 106         my (@found,$sig);
 107         my $char = shift;
 108
 109         if (length $char > 1) {
 110                 nicedie "You passed $char to scansigfile!  Must only be one character";
 111         }
 112
 113         open(SIG, "<$cfg{'tmpsigfile'}")
 114                 or nicedie "$0: Could not open $cfg{'tmpsigfile'}: $!\n";
 115         while(<SIG>) {
 116                 $sig .= $_;
 117         }
 118         close(SIG);
 119
 120         while ($sig =~ s/(\@$char([1-9][0-9]*)([RC])?@)//) {
 121                 my @array = ($1,$2);
 122                 push @array, defined($3) ? $3 : "L";
 123                 push @found, \@array;
 124         }
 125
 126         return @found;
 127 }
 128
 129 sub chunksizealign($$$) {
 130         my ($chunk,$size,$align) = @_;
 131
 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...
 136                 my ($lspc,$rspc);
 137                 $lspc=(($size - length($chunk))/2);
 138
 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);
 142                 } else {
 143                         $rspc=" " x $lspc;
 144                 }
 145                 $lspc=" " x $lspc;
 146                 $chunk=$lspc . $chunk . $rspc;
 147         } else {
 148                 $chunk=sprintf("%-$size" . "s",$chunk); # Left
 149         }
 150
 151 }
 152
 153 {
 154 my %delete;
 155
 156 sub reg_deletion($) {
 157         my $file = shift;
 158         $delete{$file}++;
 159 }
 160
 161 sub delete_tmpfiles() {
 162         return if not %delete;
 163         foreach (keys %delete) {
 164                 unlink if -f;
 165         }
 166 }
 167 }
 168
 169
 170 1;