exit;

MAIN: {

my %visited; my ($dev,$ino);

@Future{@ARGV) = (1) x @ARGV;

foreach $Start Dir (@ARGV) { delete $Future{$Start Dir);

print "\n«Modules from $Start Dir»\n\n" if $opt v;

next unless ($dev,$ino) = stat($Start Dir);

next if $visited{$dev,$ino)++;

next unless $opt a $Start Dir =" m!"/!;

find(\&wanted, $Start Dir);

exit;

Пример 12.3 (продолжение)

$1 = 1;

getopts(wvas) or die "bad usage";

@ARGV = @INC unless @ARGV;

# Глобальные переменные. Я бы предпочел обойтись без этого, use vars (

q!$Start Dir!, # Каталог верхнего уровня, для которого

# вызывалась функция find q!%Future!, # Другие каталоги верхнего уровня,

# для которых find вызывается позднее

ту $Module;

# Установить фильтр для сортировки списка модулей,

# если был указан соответствующий флаг, if ($opt s) {

if (open(ME, "--)) { $/ = • •; while (<ME>) { chomp;

print join("\n", sort split /\n/), "\n";

12.19. Программа: поиск версий и описаний установленных модулей 447

# Вычислить имя модуля по файлу и каталогу sub modname {

local $ = $File::Find::name;

if (index($ , $Start Dir . V) == 0) {

substr($ , 0, 1+length($Start 0ir)) = ;

s { / } {::}gx;

s { \.p(mod)$ } {}x;

return $ ;

# Решить, нужен ли нам данный модуль sub wanted {

if ( $Future{$File::Find::name} ) {

warn "XtCSkipping SFile::Find::name, qui venit in future.)\n"

if 0 and $opt v; SFile::Find::prune = 1; return;

return unless /\.pm$/ && -f;

SModule = &modname;

# skip obnoxious modules

if (SModule = /~CPAN(\Z::)/) {

warn("$Module -- skipping because it misbehaves\n");

return;

my Sfile = $ ;

unless (open(POD, "< Sfile")) { warn "\tcannot open Sfile: S!";

# if Sopt w; return 0;

S: = " -:";

local S/ = ; local S ; while (<POD>) {

if (/=head\d\s+NAME/) {

chomp(S = <POD>);

s/-..?-\s+ s;

s/\n/ /g;

ftwrite;

my Sv;

warn •\t(MISSING DESC FOR $File; ;Find: :name)\n" if $opt w;

return 0;

# Загрузить модуль и вывести его номер версии,

# перенаправляя ошибки в /dev/null sub getversion {

my $mod = shift;

my $vers = $"X -m$mod -e print \$${mod)::VERSION 2>/dev/nuir $vers =~ s/"\s.(.*?)\s«$/$1/; # Удалить лишние пропуски return ($vers undef);

format =

"<<«<<<<<<<<<<<<< <<<<<«<<«<<««<<«<<«<<<<<<«<<<<<<«<<«<<<<«« $Module, $

Пример 12.3 (продолжение)

if (defined ($v = getversion($Module))) {

print "$Module ($v) "; } else {

print "$Module ";

print "- $ \n"; .return 1: