5 # htag.pl - a tagline generator, sig manager and over engineered program.
6 # Copyright (C) 1999-2001 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; either version 2 of the License, or (at your option)
18 # This program is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
20 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
23 # You should have received a copy of the GNU General Public License along
24 # with this program; if not, write to the Free Software Foundation, Inc., 59
25 # Temple Place, Suite 330, Boston, MA 02111-1307 USA
27 # FIXME Check for UNIX first?
28 if ($< == 0 or $> == 0 or $( == 0 or $) == 0) {
29 die "UID/GID or effective UID/GID is 0\n".
30 "Htag is no doubt not safe for use when run as root\n";
34 # If the "use HtagPlugin 0.5;" line causes problems due to older versions of
35 # HtagPlugin lying around the system then uncomment the following with the
36 # path to your local copy of HtagPlugin
38 # use lib '/home/huggie/htag/';
42 use POSIX qw/tcgetpgrp/;
48 # Controls "Doing config filename" messages.
51 # $infinity is how many times we are allowed to loop in run_plugins
52 # That is how many times a plugin is allowed to call back to earlier ones.
53 # The counter is only increased in this case so keep it fairly small but
54 # increase this if you need to and mail huggie@earth.li to say you did so I
55 # know what is a sane magic number for future releases.
56 # Did that make sense?
60 $override{'VERSION'} = $cfg{'VERSION'} = "0.0.19";
61 $override{'HOME'} = $cfg{'HOME'} = $ENV{"HOME"} || $ENV{"LOGDIR"}
64 # srand(time() ^ ($$ + ($$ << 15) )); # Since 5.004 not required
69 # if ($cfg{'nicedie'}) {
70 # warn "Press <RETURN> to continue\n";
71 # my $throwaway=<STDIN>;
77 print STDERR "Htag.pl $cfg{'VERSION'} - Simon Huggins <huggie\@earth.li> Released under GPL\n";
78 print STDERR "Copyright (C) 1999-2001 Project Purple. http://www.earth.li/projectpurple/\n\n";
82 $cfg{'basecfgfile'}=$cfg{'HOME'} . "/.htrc";
84 $cfg{'debug'} = 0; # default. Can be overriden in cfgfile
86 # For process_configfile/undef %cfg logic.
87 $override{'basecfgfile'} = $cfg{'basecfgfile'};
89 my %getopt=( "tagfile=s" => \$override{'tagfile'},
90 "t=s" => \$override{'tagfile'},
91 "cfgfile=s" => \$override{'basecfgfile'},
92 "c=s" => \$override{'basecfgfile'},
93 "fillsig=s" => \$cfg{'fillsig'},
94 "f=s" => \$cfg{'fillsig'},
95 "help" => \$cfg{'help'},
97 "msgfile=s" => \$cfg{'msgfile'},
98 "m=s" => \$cfg{'msgfile'});
99 if (not &GetOptions(%getopt)) {
101 htag.pl - tagline and general sig adder.
102 Usage: htag.pl -t tagfile -c cfgfile -m msgfile
103 htag.pl -h gives perldoc
105 Fills a sig with spaces to check your @nn@ bits line up (or don't
106 depending what you are trying to achieve).
107 Believe me this is useful.
112 if (defined $cfg{'fillsig'}) {
113 fillsig($cfg{'fillsig'});
117 if (defined $cfg{'help'}) {
119 die "Could not run perldoc.\nPlease less $0 and read the (lack of) documentation at the end\n";
122 if (not defined $cfg{'msgfile'}) {
123 print STDERR "No message file?\n";
124 nicedie "Sorry you need to give me a message file to add to (or a new filename or -)\n";
127 # For process_configfile/undef %cfg logic.
128 $override{'msgfile'} = $cfg{'msgfile'};
129 $cfg{'basecfgfile'} = $override{'basecfgfile'};
132 sub expand_home_scalar_or_ref($); # suppress warning about unknown prototype
133 # for the calls to itself inside itself.
135 sub expand_home_scalar_or_ref($) {
138 return if not defined $foo;
140 if (ref($foo) eq 'ARRAY') {
142 $_ = expand_home_scalar_or_ref($_);
144 } elsif (ref($foo) eq 'HASH') {
145 foreach my $key (keys %{$foo}) {
146 $foo->{$key} = expand_home_scalar_or_ref($foo->{$key});
149 $foo =~ s#^~/#$cfg{'HOME'}/#o;
154 sub process_configfile {
155 my @list = ($cfg{'basecfgfile'},$cfg{'extracfgfile'});
157 # nicedie controls whether to ask for keypress when dying (useful when
158 # normally called by mutt or tin etc.)
159 # Default to on until cfgfile read. After all if there is a problem before
160 # then we want the user to know about it.
164 foreach my $cfgfile (@list) {
165 print STDERR "Doing $cfgfile\n" if $cfgdebug and defined
167 next if not defined $cfgfile;
168 unless (my $retval = do "$cfgfile") {
169 warn "couldn't parse $cfgfile: $@"
171 warn "couldn't do $cfgfile: $!"
172 unless defined $retval;
173 warn "couldn't run $cfgfile"
175 nicedie "Problem with $cfgfile! Aborting";
179 foreach (keys %override) {
180 $cfg{$_} = $override{$_} if defined $override{$_};
183 foreach my $key (keys %cfg) {
184 if (defined $cfg{$key}) {
185 $cfg{$key} = expand_home_scalar_or_ref($cfg{$key});
194 print STDERR "Running \"$program\"\n" if $cfg{'debug'};
197 # Plugins are allowed to scribble over %cfg but %cfg holds values that must
198 # be reset (generally) before a second run of the same plugin will work
199 # (the print "\n" while $cfg{'newline'}--; hit this)
200 # Plugins can change $cfg{'basecfgfile'} themselves. This is considered a
201 # feature. (Stop laughing at the back there).
202 # To ensure that plugins written in other languages see the changes to %cfg
203 # this is done for both forks of the if.
204 process_configfile();
207 if ($lines =~ m&^#!/[a-zA-Z/.-]+perl .*$&) {
208 { # Otherwise $/ is undef in eval. Mucho ick.
214 # I tried to use Safe to do this but it fouls up when using modules.
216 $program =~ s/.*?([^\/]+)$/$1/;
217 my $eval_code = "package HtagPlugin::$package_num;".
218 'local $SIG{\'__WARN__\'} = sub { (my $mess = $_[0])'.
219 " =~ s/\\(eval[^)]*\\)/$program/g; ".
220 ' $mess =~ s/(HtagPlugin::)\d+::([^ ]*)/$1$2/; '.
222 "my \$rc = eval {$lines}; ".
223 'die $@ if $@; $rc;';
225 $_ = "HtagPlugin::$package_num";
228 *{$_.'::cfg'} = \%cfg;
229 *{$_.'::htagdie'} = \&nicedie;
230 *{$_.'::subst_macros'} = \&subst_macros;
231 *{$_.'::scansigfile'} = \&scansigfile;
232 *{$_.'::process_msgbody'}
234 *{$_.'::process_configfile'}
235 = \&process_configfile;
236 *{$_.'::chunksizealign'}
238 *{$_.'::reg_deletion'}
241 $rc = eval $eval_code;
242 $override{'notag'} = $cfg{'notag'} if defined $cfg{'notag'};
244 $@ =~ s/\(eval[^)]*\)/$program/g;
245 nicedie "$program: $@";
247 if (not defined $rc) {
251 # if not perl construct arg list
252 my @args = ($cfg{'msgfile'},$cfg{'basecfgfile'},
255 $rc = 0xffff & system($program,@args);
261 $msg = "Plugin control, plugin $program requesting clearance to die...\n" if $cfg{'debug'};
262 nicedie $msg; # Ensure we wait on a keypress if asekd to
263 } elsif ($rc == 255) {
265 $msg = "User requested death... Complying.\n" if $cfg{'debug'};
269 return $rc unless $rc == 253;
272 nicedie "$program does not exist!\n";
280 return @{$ref}[rand scalar @{$ref}];
285 my (@plugins,%plugins,$program);
287 opendir(DIR, $dir) or nicedie "Cannot open $dir: $!\n";
288 @plugins = grep { -f $_ }
294 foreach my $plugin (@plugins) {
295 if ($plugin !~ m#/(\d\d).+$#) {
296 nicedie "Found unexpected $plugin\n";
298 push @{$plugins{$1}}, $plugin;
302 my @order = sort keys %plugins;
303 my (@trueorder,$infinite_loop);
308 while (my $num = shift @order) {
309 $program = pick_rand(@{$plugins{$num}});
310 if (my $back = run_plugin($program)) {
312 while ($redo[0] < $back) {
317 if ($infinite_loop > $infinity) {
318 nicedie "Purple Alert! This is not a daffodil! Too much recursion\n".
319 "This probably happened because your taglines are too short compared to the\n".
320 "space left in the sig chosen.\n";
328 my ($sig,$len,$type);
330 open(HANDLE, $sigfile) or nicedie "Could not open $sigfile!: $!";
336 while ($sig =~ /@[A-Za-z]?[1-9][0-9]*[RC]?@/) {
337 $sig =~ s/@[A-Za-z]?([1-9][0-9]*)[RC]?@/" "x$1/e;
339 $sig =~ s/\@V/$cfg{'VERSION'}/g;
344 sub choose_configfile() {
345 process_configfile(); # Pick up the changeconf stuff.
347 return $cfg{'basecfgfile'} if not defined $cfg{'changeheaders'};
351 if (defined $cfg{'changeheaders'}) {
352 open(HANDLE, $cfg{'msgfile'});
353 my (@headers,$match,@l);
354 while (my $line = <HANDLE>) {
355 last if ($line =~ /^$/); # end of headers
356 push @headers, $line;
358 foreach (@{$cfg{'changeheaders'}}) {
361 eval { "" =~ /$_/; };
362 nicedie "Pattern \"$_\" would have killed me if I'd tried to run it.\nPerl said: $@" if $@;
366 # There must be a nicer way to implement this?
367 CH: foreach (@{$cfg{'changeheaders'}}) {
371 foreach my $line (@headers) {
372 PAT: foreach my $pattern (@l) {
373 if ($line =~ /$pattern/) {
375 $file =~ s/\$1/$temp/e
381 if ($match == @l or $l[0] eq "") {
382 $override{'extracfgfile'} =
383 $cfg{'extracfgfile'} = $file;
387 if (not @headers and $l[0] eq "") {
388 $override{'extracfgfile'} =
389 $cfg{'extracfgfile'} = $file;
405 if (not defined $cfg{'plugindir'}) {
406 nicedie "Sorry, \$cfg{'plugindir'} was not defined in your config file.\n";
408 if ($cfg{'plugindir'} !~ m#/$#) { $cfg{'plugindir'} .= "/"; }
409 run_plugins($cfg{'plugindir'});
420 htag.pl - Add taglines and sigs to email, news and fidonet messages.
424 htag.pl [I<-t> tagfile I<-c> cfgfile] I<-m> msgfile
426 htag.pl I<-f> sigfile
432 B<htag.pl> is a sigmonster. It is designed to be extendable in many
433 different ways through its use of plugins. It might be getting a little bit
434 too sentient in its old age though.
436 It can be used like this:
442 For information on configuration see the B<sample.htrc> file
444 To create signature files, it is tedious to have to work out what will and
445 won't line up. This is why the I<-f> option exists. Feed it a sigfile
446 and it will replace the @[0-9]+[RC]?@ bits with required number of spaces so
447 you can see if you got it right or not. (You could even run it from your
448 favourite editor e.g. C<:! htag.pl -f %> for vim on the current file.)
452 Inserting a tagline containing C<@[0-9]+[RC]?@> has interesting
455 This documentation is useless. Use The Source Luke.
469 http://www.earth.li/progs/htag.html
473 Simon Huggins <huggie@earth.li>