Глава б Поиск по шаблону

6.22. Программа: tcgrep

#!/usr/bin/perl -w
# tcgrep: версия grep, написанная на Perl
# версия 1.0: 30 сентября 1993 года
# версия 1.1: 1 октября 1993 года
# версия 1.2: 26 июля 1996 года
# версия 1.3: 30 августа 1997 года
# версия 1.4: 18 мая 1998 года
use strict;
# Глобальные переменные
use vars qw($Me $Errors $Grand_Total $Mult %Compress $Matches);
my ($matcher, $opt);
init();
# matcher - анонимная функция
# для поиска совпадений
# opt - ссылка на хэш, содержащий
# параметры командной строки
# Инициализировать глобальные переменные
($opt, $matcher) = parse_args(); # Получить параметры командной строки и и шаблоны
matchfile($opt, $matcher, OARGV); # Обработать файлы
exit(2) if $Errors;
exit(O) if $Grand_Total;
exit(-l);
t("##"#################"############
sub init {
($Me = $0) =~ s!.*/!!;
$Errors = $Grand_Total=0; $Mult = oo";
$1 = 1;
%Compress = (
z => 'gzcat',
gz => ogzcat',
Z => 'zcat',
);
}
# Получить базовое имя программы,
"tcgrep' # Инициализировать глобальные счетчики
# Флаг для нескольких файлов в @ARGV
# Автоматическая очистка выходного буфера
# Расширения и имена программ # для распаковки
sub usage {
die "EOF usage: $Me [flags] [files]
Standard grep options:
i case insensitive
n number lines
c give count of lines matching
C ditto, but >1 match per line possible
w word boundaries only
s silent mode
x exact matches only
v invert search sense (lines that DON'T match)
h hide filenames
e expression (for exprs beginning with -)
f file with expressions 1 list filenames matching
Specials:
1 1 match per file
H highlight matches
u underline matches
r recursive on directories or dot if none
t process directories in 'Is -t' order
p paragraph mode (default: line mode)
P ditto, but specify separator, e.g. -P '%%\\n'
a all files, not just plain text files
q quiet about failed file and dir opens
T trace files as opened
May use a TCGREP environment variable to set default options.
EOF
}
##################################
sub parse_args { use Getopt::Std;
my ($optstring, $zeros, $nulls, %opt, $pattern, @patterns, $match_code);
my ($SO, $SE);
if ($_ = $ENV{TCGREP}) { # Получить переменную окружения
TCGREP s/"(["\-])/-$1/; # Если начальный - отсутствует, добавить
unshift(@ARGV, $_); # Включить строку TCGREP в @ARGV
}
$optstring = "incCwsxvhe:f:l1HurtpP:aqT";
$zeros = 'inCwxvhelut'; # Параметры, инициализируемые О
# (для отмены предупреждений)
$nulls = 'рР'; # Параметры, инициализируемые
# (для отмены предупреждений)
@opt{ split //, $zeros } = ( 0 ) х length($zeros);
@>opt{ split //, $nulls } = ( 'o ) x length($nulls); getopts($optstring, \%opt) or usage();
if ($opt{f}) { # -f файл с шаблонами
open(PATFILE, $opt{f}) or
die qq($Me: Can't open '$opt{f}': $!);
# Проверить каждый шаблон в файле
while ( defined($pattern = ) ) {
chomp $pattern;
eval { 'too' =~ /$pattern/, 1 } or
die "$Me: $opt{f}:$.: bad pattern: $@" push @patterns, $pattern;
} close PATFILE;
}
else { # Проверить шаблон
$pattern = $opt{e} || shift(@ARGV) || usage()
eval { 'too' =~ /$pattern/, 1 } or die "$Me: bad pattern: $@";
@patterns = ($pattern);
}
if ($opt{H} || $opt{u}) { # Выделить или подчеркнуть
my $term = $ENV{TERM} || ovt-100';
my $terminal;
eval { # Попытаться найти служебные
# последовательности для выделения
require POSIX; # или подчеркнуть через
Теrm::Сар use Term::Cap;
mу $termios = POSIX::Termios->new();
$termios->getattr;
ту $ospeed = $termios->getospeed;
$terminal = Tgetent Term::Cap { TERM=>under, OSPEED=>$ospeed }
};
unless ($@) { # Если успешно, получить служебные
# последовательности для выделения
(-Н) local $"W =0: # или подчеркивания (-u)
($80, $SE) = $opt{H}
? ($terminal->Tputs('so'),
$terminal->Tputs('se')) : ($terminal->Tputs('us'),
$terminal->Tputs('ue'));
} else { # Если попытка использования Term::Cap
# заканчивается неудачей, получить
($80, $SE) = $opt{H} # служебные последовательности
# командой tput
? ('tput -Т $term smso', 'tput -T $term rmso') : ('tput -T $term smul', 'tput -T $term
rmul') }
}
if ($opt{i}) {
@patterns = map {"(?!)$_"} ©patterns;
}
if ($opt{p} || $opt{P}) {
@patterns = map {"(?т)$_"} @patterns;
}
$opt{p} && ($/ = oo);
$opt{P} && ($/ = eval(qq("$opt{P}"))); # for -P '%%\n' $opt{w} && (©patterns =
map {'\b' . $_ . '\b'} ©patterns);
$opt{'x'} && (©patterns = map {""$_\$"} ©patterns);
if (@ARGV) {
$Mult - 1 if ($opt{r} || (@ARGV > 1) | -d $ARGV[0]) && !$opt{h};
}
$opt{1} += $opt{l}; # Единица и буква 1
$opt{H} += $opt{u};
$opt{c} += $opt{C};
$opt{'s'} += $opt{c};
$opt{1} += $opt{'s'} && !$opt{c}; # Единица
@ARGV = ($opt{r} ? '.o : '-o) unless ©ARGV;
$opt{r} = 1 if !$opt{r} && grep(-d, ©ARGV) == @ARGV;
$match_code = ' ';
$match_code .= 'study;' if ©patterns > 5; # Может немного
# ускорить работу
foreach (@patterns) { s(/)(\\/)g }
if ($opt{H}) {
foreach $pattern (©patterns) {
$match_code .= "\$Matches += s/($pattern)/${SO}\$1${SE}/g;";
}
}
elsif ($opt{v}) {
foreach $pattern (@patterns) {
$match_code .= "\$Matches += !/$pattern/;";
}
}
elsif ($opt{C}) {
foreach $pattern (©patterns) {
$match_code .= "\$Matches++ while /$pattern/g;
}
} else {
foreach $pattern (©patterns) {
$match_code .= "\$Matches++ if /$pattern/;";
}
}
$matcher = eval "sub { $match_code }";
die if $@;
return (\%opt, $matcher);
}
#############################
sub matchfile {
$opt = shift; # Ссылка на хэш параметров
$matcher = shift; # Ссылка на функцию поиска совпадений
my ($file, @list, $total, $name);
local($_);
$total = 0;
FILE: while (defined ($file = shift(@>_))) {
if (-d $file) {
if (-1 $file && @ARGV != 1) {
warn "$Me: \"$file\" is a symlink to a directory\n" if $opt->{T};
next FILE;
} if (!$opt->{r}) {
warn "$Me: \"$file\" is a directory, but no -r given\n" if $opt->{T};
next FILE;
}
unless (opendir(DIR, $fiie)) {
unless ($opt->{'q'}) {
warn "$Me; can't opendir $file: $!\n";
$Errors++;
}
next FILE;
}
@list =();
for (readdir(DIR)) {
push(@list, "$file/$_") unless/~\.{1,2}$/;
} closedir(DIR);
if ($opt->{t}) {
my (@dates);
for (@>list) { push(@dates, -M) }
@list = @list[sort { $dates[$a] <=> $dates[$b] } 0..$#dates];
} else {
@list = sort @list:
}
matchfile($opt, $matcher, @list); # process files next FILE;
}
if ($file eq o-o) {
warn "$Me: reading from stdin\n"
if -t STDIN && !$opt->{'q' $name = '';
}
else {
$name = $file;
unless (-e $file) {
warn qq($Me: file "$file" does not exist\n) unless $opt->{'q'};
$Errors++;
next FILE;
}
unless (-f $file \\ $upt->{ci/) {
warn qq($Me: skipping non-plain file "$file"\n) if $opt->{T};
next FILE;
}
my ($ext) = $file =~ /\.([".]+)$/;
if (defined $ext && exists $Compress{$ext}) { $file ^ "$Compress{$ext} <$file |";
}
elsif (! (-T $file || $opt->{a})) {
warn qq($Me: skipping binary file "$file"\n) if $opt->{T} next FILE:
}
}
warn "$Me: checking $file\n" if $opt->{T};
unless (open(FILE, $file)) { unless ($opt->{'q'}) {
warn "$Me: $file: $!\n":
$Errors++;
}
next FILE;
}
$total = 0;
$Matches = 0;
LINE: while () { $Matches = 0;
#############
&{$matcher}(); # Поиск совпадений
###########
next LINE unless $Matches;
$total += $Matches;
if ($opt->{p} ]| $opt->{P}) {
s/\n{2,}$/\n/ if $opt->{p};
chomp if $opt->{P};
}
print("$name\n"), next FILE if $opt->{!}:
$opt->{'s'} 1) print $Mult && "$name:", $opt->{n} ? "$.:" : "", $_, ($opt->{p} ||
$opt->{P}) && ('-' x 2(J) . "\n";
next FILE if $opt->{1}; # Единица
}
}
continue {
print $Mult && "$name:", $total, "\n" if $opt->{c};
} $Grand_Total += $total;
}

6.23. Копилка регулярных выражений

© copyright 2000 Soft group