File: 02catsig

package info (click to toggle)
htag 0.0.24-2
  • links: PTS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 356 kB
  • sloc: perl: 1,302; makefile: 20; sh: 2
file content (130 lines) | stat: -rw-r--r-- 3,888 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
#!/usr/bin/perl -w

# Copyright (C) 2000-2003 Simon Huggins
# catsig deals with choosing a sig

# 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


# You can either specify sigs with
# 	$cfg{'sigs'}
# 		An arrayref to an array of filenames of sigs.
# 	$cfg{'sigdir'}
# 		A scalar containing a directory of all your sig files.
# 	$cfg{'sigmatch'}
# 		A scalar containing a pattern to match the files in sigdir
# 		(full path) against.
#
#	So specifying sigdir without sigmatch takes all the files in that
#	directory that don't start with a fullstop (period) and specifying
#	it with sigmatch only takes those that match.
#	Note that if you specify sigs *AND* sigdir you'll get all of sigs
#	and anything that sigdir/sigmatch matches.
#	The program dies if after trying to match it comes up with nothing.

use strict;

if (defined $cfg{'sigdir'}) {
	opendir(DIR, $cfg{'sigdir'})
		or htagdie "Could not open directory $cfg{'sigdir'}: $!\n";
	if (not defined $cfg{'sigmatch'}) {
		push @{$cfg{'sigs'}}, 	map  { $cfg{'sigdir'} . "/" . $_ }
					grep { ! /^\./ }
					readdir(DIR);
	} else {
		# Check regexp wouldn't kill us
		exec { "" =~ $cfg{'sigmatch'};}
		htagdie "sigmatch contained bad pattern.  perl said: $@" if $@;
		push @{$cfg{'sigs'}}, grep { m,$cfg{'sigmatch'}, }
					map  { $cfg{'sigdir'} . "/" . $_ }
					readdir(DIR);
		print STDERR "Got sigmatch == $cfg{'sigmatch'}\n";
	}
	closedir(DIR);
}

htagdie <<EOF if (not defined $cfg{'sigs'} or scalar @{$cfg{'sigs'}} == 0);
No signatures found.  Either you didn't specify sigs, or there weren't any
files in sigdir or your sigmatch didn't match anything.
EOF

sub quit() {
	return 255;
}

sub write_sig($) {
	my $sig = shift;

	open(OUT, ">$cfg{'tmpsigfile'}") or htagdie "Couldn't open $cfg{'tmpsigfile'}";
	print OUT $sig;
	close(OUT);
	open(OUT, ">$cfg{'tmpsigfile'}.old") or htagdie "Couldn't open $cfg{'tmpsigfile'}.old";
	print OUT $sig;
	close(OUT);
}

sub choose_sig {
### Choose a sig and read it into $sig for grepping for @72@ or whatever.
	my ($sigfile,@oldsiglist,@siglist,$num,$sig);

	@oldsiglist = @siglist = @{$cfg{'sigs'}};

	do {	
		$sig="";

		if (@siglist) {
			# Find and delete
			$sigfile=splice(@siglist,rand(@siglist),1);
		} elsif (-r "$cfg{'HOME'}/.sig") {
			print STDERR "Falling back on ~/.sig\n" if $cfg{'debug'};
			$sigfile="$cfg{'HOME'}/.sig";
		} else {
			print STDERR "No sigs specified and no ~/.sig!  Using simple tag method\n";
		}
		
		if (not $sigfile) {
			$sig="";
			write_sig($sig);
			return;
		}
		
		print STDERR "Using $sigfile\n" if $cfg{'debug'};

		open(HANDLE, "<$sigfile") or htagdie "Could not open $sigfile: $!\n";
		while(<HANDLE>) { $sig .= $_ };
		close(HANDLE);

		if ($cfg{'asksig'}) {
			print STDERR $sig . "\nUse this sig? ([y]/n/q)";
			$_ = <STDIN>;
			if ($_ =~ /q(?:uit)?/i) { return &quit; }
			if (not @siglist and $_ =~ /no?/i) {
				print STDERR "That was the last sig.  Reset siglist or quit? ([r]/q)";
				$_ = <STDIN>;
				if ($_ =~ /q(?:uit)?/i) { return &quit; }
				@siglist = @oldsiglist;
				$_ = 'n';
			}

		}

	} while ($cfg{'asksig'} and $_ !~ /y(?:es)?/i and $_ !~ /^\n$/);
	write_sig($sig);
	return;
}

reg_deletion($cfg{'tmpsigfile'});
reg_deletion("$cfg{'tmpsigfile'}.old");
&choose_sig;