Приглашаем посетить
6.22. Программа: tcgrep
Ниже приведена программа UNIX grep, написанная на Perl. Хотя она работает медленнее версий, написанных на С (особенно GNU-версии grep), зато обладает многими усовершенствованиями.
Первая и самая важная особенность - эта программа работает везде, где работает Perl. Имеется ряд дополнительных возможностей - tcgrep игнорирует все файлы, кроме простых текстовых; распаковывает сжатые или обработанные утилитой gzip файлы; выполняет просмотр в подкаталогах; ищет полные абзацы или записи, определенные пользователем; ищет более свежие версии файлов, а также подчеркивает или выделяет найденные совпадения. Кроме того, параметр -с выводит количество найденных записей, а параметр -С - число найденных совпадений, которые могут содержать несколько записей.
Распаковка сжатых файлов выполняется утилитами gzcat или zcat, поэтому данная возможность отсутствует в системах, где эти программы недоступны, а также в системах, не позволяющих запускать внешние программы (например, Macintosh).
При запуске программы без аргументов на экран выводится краткая справка по ее использованию (см. процедуру usage в программе). Следующая командная строка рекурсивно и без учета регистра ищет во всех файлах почтового ящика '/mail сообщения с отправителем "kate" и выводит имена найденных файлов:
% tcgrep -ril '"From: .*kate' '/mail Исходный текст программы приведен в примере 6.14.
Пример 6.14. 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;
}
Следующие регулярные выражения показались нам особенно полезными или интересными.
Римские цифры
m/-m.(d?c{0,3}|c[dm])(1^x{0,3}|x[1c])(v?i{0,3}|i[vx])$/i
Перестановка двух первых слов
s/(\S+))\s+)(\S+)/$3$2$1/
Ключевое слово = значение
(n/(\w+)\s*=\s*(.*)\s*$/ # Ключевое слово в $1, значение - в $2
Строка содержит не менее 80 символов
т/.{80,}/
мм/дд/гг чч:мм:сс
т|(\d+)/(\d+)/\d+) (\d+):(\d+):(\d+)|
Смена каталога
s(/usr/bin)(/usr/local/bin)g
Расширение служебных последовательностей %7Е(шестн.)
s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex 41/ge
Удаление комментариев С (не идеальное)
S{
/\* # Начальный ограничитель
.*? # Минимальное количество символов
\*/ # Конечный ограничитель
} []gsx;
Удаление начальных и конечных пропусков
s/"\s+//;
s/\s+$//;
Преобразование символа \ и следующего за ним п в символ перевода строки
s/\W\n/g;
Удаление пакетных префиксов из полностью определенных символов
s/-..:://
IP-адрес
m/~[01]Ad\d|2[0-4]\d|25[0-5])\.([01]Ad\d|2[0-4]\d|25[0-5])\.
([01]?\d\d|2[0-4]\d|25[0-5])\.([01]Ad\d|2[0-4]\d|25[0-5])$/;
Удаление пути из полного имени файла
sC-../Ю
Определение ширины строки с помощью TERMCAP
$cols = ( ($env{termcap} || " oo) =~ m/:coff(\d+):/ ) ? $1 : 80:
Удаление компонентов каталогов из имени программы и аргументов
($name = join(" ", map { s,"\s+/,,; $_ } ($0 @argv));
Проверка операционной системы
die "This isn't Linux" unless $"0 =~m/linux/i;
Объединение строк в многострочных последовательностях
s/\n\s+/ /g;
Извлечение всех чисел из строки
@nums = m/(\d+\.'''\d*|\.\d+)/g;
Поиск всех слов, записанных символами верхнего регистра
@capwords = m/(\b[~\wa-zo-9_]+\b)/g;
Поиск всех слов, записанных символами нижнего регистра
@capwords = m/(\b["\wa-zo-9_]+\b)/g;
Поиск всех слов, начинающихся с буквы верхнего регистра
(Sicwords = m/(\b["\wa-zo-9_]["\wa-zo-9_]*\b)/;
@links = m/]+7HREF\s*=\s*['"]?(["'" >]^)[ "o]?>/sig;
Поиск среднего инициала в $_
$initial = m/"\s+\s+(\s)\s*\s+\s/ ? $1 : "";
Замена кавычек апострофами
s/"([-"]*)V"$r7g Выборка предложений (разделитель - два пробела)
{ local $/ = "";
while (о) { s/\n/ /g;
s/ <3,}/ /g;
push ^sentences, m/(\S.*?[!?.])(?= |\z)/g;
}
}
ГГГГ-ММ-ДД
m/(\d{4})-(\d\d)-(\d\d)/ # ГГГГ в $1, MM в $2 и ДД в $3
Выборка строк независимо от терминатора (завершающего символа)
push(@lines, $1)
while ($input =~ s/~(["\012\015]*)(\012\015?|\015\012?)//);
