5 # htag.pl - a tagline generator, sig manager and over engineered program.
6 # Copyright (C) 1999-2003 Project Purple, Simon Huggins
8 # Simon Huggins <huggie@earth.li>
9 # http://www.earth.li/projectpurple/progs/htag.html
10 # For ChangeLog and Known Bugs see HISTORY and BUGS.
13 # This program is free software; you can redistribute it and/or modify it
14 # under the terms of the GNU General Public License as published by the Free
15 # Software Foundation; version 2 of the License only
17 # This program is distributed in the hope that it will be useful, but
18 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
19 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
22 # You should have received a copy of the GNU General Public License along
23 # with this program; if not, write to the Free Software Foundation, Inc., 59
24 # Temple Place, Suite 330, Boston, MA 02111-1307 USA
26 # FIXME Check for UNIX first?
27 if ($< == 0 or $> == 0 or $( == 0 or $) == 0) {
28 die "UID/GID or effective UID/GID is 0\n".
29 "Htag is no doubt not safe for use when run as root\n";
33 # If the "use HtagPlugin 0.5;" line causes problems due to older versions of
34 # HtagPlugin lying around the system then uncomment the following with the
35 # path to your local copy of HtagPlugin
37 # use lib '/home/huggie/perl/huggietag/htag-0.0.23/HtagPlugin';
41 use POSIX qw/tcgetpgrp/;
47 # Controls "Doing config filename" messages.
50 # $infinity is how many times we are allowed to loop in run_plugins
51 # That is how many times a plugin is allowed to call back to earlier ones.
52 # The counter is only increased in this case so keep it fairly small but
53 # increase this if you need to and mail huggie@earth.li to say you did so I
54 # know what is a sane magic number for future releases.
55 # Did that make sense?
59 $override{'VERSION'} = $cfg{'VERSION'} = "0.0.23";
60 $override{'HOME'} = $cfg{'HOME'} = $ENV{"HOME"} || $ENV{"LOGDIR"}
64 # srand(time() ^ ($$ + ($$ << 15) )); # Since 5.004 not required
67 print STDERR "Htag.pl $cfg{'VERSION'} - Simon Huggins <huggie\@earth.li> Released under GPL\n";
68 print STDERR "Copyright (C) 1999-2002 Project Purple. http://www.earth.li/projectpurple/\n\n";
72 $cfg{'basecfgfile'}=$cfg{'HOME'} . "/.htrc";
74 $cfg{'debug'} = 0; # default. Can be overriden in cfgfile
76 # For process_configfile/undef %cfg logic.
77 $override{'basecfgfile'} = $cfg{'basecfgfile'};
79 my %getopt=( "tagfile=s" => \$override{'tagfile'},
80 "t=s" => \$override{'tagfile'},
81 "cfgfile=s" => \$override{'basecfgfile'},
82 "c=s" => \$override{'basecfgfile'},
83 "fillsig=s" => \$cfg{'fillsig'},
84 "f=s" => \$cfg{'fillsig'},
85 "help" => \$cfg{'help'},
87 "msgfile=s" => \$cfg{'msgfile'},
88 "m=s" => \$cfg{'msgfile'});
89 if (not &GetOptions(%getopt)) {
91 htag.pl - tagline and general sig adder.
92 Usage: htag.pl -t tagfile -c cfgfile -m msgfile
93 htag.pl -h gives perldoc
95 Fills a sig with spaces to check your @nn@ bits line up (or don't
96 depending what you are trying to achieve).
97 Believe me this is useful.
102 if (defined $cfg{'fillsig'}) {
103 fillsig($cfg{'fillsig'});
107 if (defined $cfg{'help'}) {
109 die "Could not run perldoc.\nPlease less $0 and read the (lack of) documentation at the end\n";
112 if (not defined $cfg{'msgfile'}) {
113 print STDERR "No message file?\n";
114 nicedie "Sorry you need to give me a message file to add to (or a new filename or -)\n";
117 # For process_configfile/undef %cfg logic.
118 $override{'msgfile'} = $cfg{'msgfile'};
119 $cfg{'basecfgfile'} = $override{'basecfgfile'};
122 sub expand_home_scalar_or_ref($); # suppress warning about unknown prototype
123 # for the calls to itself inside itself.
125 sub expand_home_scalar_or_ref($) {
128 return if not defined $foo;
130 if (ref($foo) eq 'ARRAY') {
132 $_ = expand_home_scalar_or_ref($_);
134 } elsif (ref($foo) eq 'HASH') {
135 foreach my $key (keys %{$foo}) {
136 $foo->{$key} = expand_home_scalar_or_ref($foo->{$key});
139 $foo =~ s#^~/#$cfg{'HOME'}/#o;
144 sub process_configfile {
145 my @list = ($cfg{'basecfgfile'},$cfg{'extracfgfile'});
147 # nicedie controls whether to ask for keypress when dying (useful when
148 # normally called by mutt or tin etc.)
149 # Default to on until cfgfile read. After all if there is a problem before
150 # then we want the user to know about it.
154 foreach my $cfgfile (@list) {
155 print STDERR "Doing $cfgfile\n" if $cfgdebug and defined
157 next if not defined $cfgfile;
158 unless (my $retval = do "$cfgfile") {
159 warn "couldn't parse $cfgfile: $@"
161 warn "couldn't do $cfgfile: $!"
162 unless defined $retval;
163 warn "couldn't run $cfgfile"
165 nicedie "Problem with $cfgfile! Aborting";
169 foreach (keys %override) {
170 $cfg{$_} = $override{$_} if defined $override{$_};
173 foreach my $key (keys %cfg) {
174 if (defined $cfg{$key}) {
175 $cfg{$key} = expand_home_scalar_or_ref($cfg{$key});
184 print STDERR "Running \"$program\"\n" if $cfg{'debug'};
187 # Plugins are allowed to scribble over %cfg but %cfg holds values that must
188 # be reset (generally) before a second run of the same plugin will work
189 # (the print "\n" while $cfg{'newline'}--; hit this)
190 # Plugins can change $cfg{'basecfgfile'} themselves. This is considered a
191 # feature. (Stop laughing at the back there).
192 # To ensure that plugins written in other languages see the changes to %cfg
193 # this is done for both forks of the if.
194 process_configfile();
197 if ($lines =~ m&^#!/[a-zA-Z/.-]+perl .*$&) {
198 { # Otherwise $/ is undef in eval. Mucho ick.
204 # I tried to use Safe to do this but it fouls up when using modules.
206 $program =~ s/.*?([^\/]+)$/$1/;
207 my $eval_code = "package HtagPlugin::$package_num;".
208 'local $SIG{\'__WARN__\'} = sub { (my $mess = $_[0])'.
209 " =~ s/\\(eval[^)]*\\)/$program/g; ".
210 ' $mess =~ s/(HtagPlugin::)\d+::([^ ]*)/$1$2/; '.
212 "my \$rc = eval {$lines}; ".
213 'die $@ if $@; $rc;';
215 $_ = "HtagPlugin::$package_num";
218 *{$_.'::cfg'} = \%cfg;
219 *{$_.'::htagdie'} = \&nicedie;
220 *{$_.'::subst_macros'} = \&subst_macros;
221 *{$_.'::scansigfile'} = \&scansigfile;
222 *{$_.'::process_msgbody'}
224 *{$_.'::process_configfile'}
225 = \&process_configfile;
226 *{$_.'::chunksizealign'}
228 *{$_.'::reg_deletion'}
231 $rc = eval $eval_code;
232 $override{'notag'} = $cfg{'notag'} if defined $cfg{'notag'};
234 $@ =~ s/\(eval[^)]*\)/$program/g;
235 nicedie "$program: $@";
237 if (not defined $rc) {
241 # if not perl construct arg list
242 my @args = ($cfg{'msgfile'},$cfg{'basecfgfile'},
245 $rc = 0xffff & system($program,@args);
251 $msg = "Plugin control, plugin $program requesting clearance to die...\n" if $cfg{'debug'};
252 nicedie $msg; # Ensure we wait on a keypress if asekd to
253 } elsif ($rc == 255) {
255 $msg = "User requested death... Complying.\n" if $cfg{'debug'};
259 return $rc unless $rc == 253;
262 nicedie "$program does not exist!\n";
270 return @{$ref}[rand scalar @{$ref}];
275 my (@plugins,%plugins,$program);
277 opendir(DIR, $dir) or nicedie "Cannot open $dir: $!\n";
278 @plugins = grep { -f $_ }
284 foreach my $plugin (@plugins) {
285 if ($plugin !~ m#/(\d\d).+$#) {
286 nicedie "Found unexpected $plugin\n";
288 push @{$plugins{$1}}, $plugin;
292 my @order = sort keys %plugins;
293 my (@trueorder,$infinite_loop);
298 while (my $num = shift @order) {
299 $program = pick_rand(@{$plugins{$num}});
300 if (my $back = run_plugin($program)) {
302 while ($redo[0] < $back) {
307 if ($infinite_loop > $infinity) {
308 nicedie "Purple Alert! This is not a daffodil! Too much recursion\n".
309 "This probably happened because your taglines are too short compared to the\n".
310 "space left in the sig chosen.\n";
318 my ($sig,$len,$type);
320 open(HANDLE, $sigfile) or nicedie "Could not open $sigfile!: $!";
326 while ($sig =~ /@[A-Za-z]?[1-9][0-9]*[RC]?@/) {
327 $sig =~ s/@[A-Za-z]?([1-9][0-9]*)[RC]?@/" "x$1/e;
329 $sig =~ s/\@V/$cfg{'VERSION'}/g;
334 sub choose_configfile() {
335 process_configfile(); # Pick up the changeconf stuff.
337 return $cfg{'basecfgfile'} if not defined $cfg{'changeheaders'};
341 if (defined $cfg{'changeheaders'}) {
342 my (@headers,$match,@l);
343 if (open(HANDLE, $cfg{'msgfile'})) {
344 while (my $line = <HANDLE>) {
345 last if ($line =~ /^$/); # end of headers
346 push @headers, $line;
350 foreach (@{$cfg{'changeheaders'}}) {
353 eval { "" =~ /$_/; };
354 nicedie "Pattern \"$_\" would have killed me if I'd tried to run it.\nPerl said: $@" if $@;
358 # There must be a nicer way to implement this?
359 CH: foreach (@{$cfg{'changeheaders'}}) {
363 foreach my $line (@headers) {
364 PAT: foreach my $pattern (@l) {
365 if ($line =~ /$pattern/) {
367 $file =~ s/\$1/$temp/e
373 if ($match == @l or $l[0] eq "") {
374 $override{'extracfgfile'} =
375 $cfg{'extracfgfile'} = $file;
379 if (not @headers and $l[0] eq "") {
380 $override{'extracfgfile'} =
381 $cfg{'extracfgfile'} = $file;
396 if (not defined $cfg{'plugindir'}) {
397 nicedie "Sorry, \$cfg{'plugindir'} was not defined in your config file.\n";
399 if ($cfg{'plugindir'} !~ m#/$#) { $cfg{'plugindir'} .= "/"; }
400 run_plugins($cfg{'plugindir'});
411 htag.pl - Add taglines and sigs to email, news and fidonet messages.
415 htag.pl [I<-t> tagfile I<-c> cfgfile] I<-m> msgfile
417 htag.pl I<-f> sigfile
423 B<htag.pl> is a sigmonster. It is designed to be extendable in many
424 different ways through its use of plugins. It might be getting a little bit
425 too sentient in its old age though.
427 It can be used like this:
433 For information on configuration see the B<sample.htrc> file
435 To create signature files, it is tedious to have to work out what will and
436 won't line up. This is why the I<-f> option exists. Feed it a sigfile
437 and it will replace the @[0-9]+[RC]?@ bits with required number of spaces so
438 you can see if you got it right or not. (You could even run it from your
439 favourite editor e.g. C<:! htag.pl -f %> for vim on the current file.)
443 Inserting a tagline containing C<@[0-9]+[RC]?@> has interesting
446 This documentation is useless. Use The Source Luke.
460 http://www.earth.li/progs/htag.html
464 Simon Huggins <huggie@earth.li>