Глава 9 Каталоги

9.10. Деление имени файла на компоненты

Проблема

Решение

use File::Basename;
$base = basename($path);
$dir = dirname($path);
($base, $dir, $ext) = fileparse($path);

Комментарий

$path = '/usr/lib/libc.a';
$file = basename($path);
$dir = dirname($path);
print "dir is $dir, file is $file\n";
# dir is /usr/lib, file is libc.a
Функция fileparse может использоваться для извлечения расширений. Для этого передайте fileparse полное имя и регулярное выражение для поиска расширения. Шаблон необходим из-за того, что расширения не всегда отделяются точкой. Например, что считать расширением в ".tar.gz" - ".tar", ".gz" или ".tar.gz"? Передавая шаблон, вы определяете, какой из перечисленных вариантов будет возвращен:
$path = '/usr/lib/libc.a';
($name,$dir,$ext) = fileparse($path,'\..*');
print "dir is $dir, name is $name, extension is $ext\n";
# dir is /usr/lib/, name is libc, extension is .a
По умолчанию в работе этих функций используются разделитель, определяемый стандартными правилами вашей операционной системы. Для этого используется переменная $"0; содержащаяся в ней строка идентифицирует текущую систему. Ее значение определяется в момент построения и установки Perl. Значение по умолчанию можно установить с помощью функции fileparse_set_fstype. В результате изменится и поведение функций File::Basename при последующих вызовах:
fileparse_set_fstype("MacOS");
$path = "Hard%20Drive:System%20Folder:README,txt";
($name,$dir,$ext) = fileparse($path,'\..*o);
print "dir is $dir, name is $name, extension is $ext\n":
# dir is Hard%20Drive:System%20Folder, name is README, extension is .txt

Расширение можно получить следующим образом:

sub extension {
my $path = shift;
my $ext = (fileparse($path,o\..*'))[2]; .
$ext =~ s/"\.//;
return $ext;
}

Для файла source.c.bak вместо простого "bak" будет возвращено расширение "с. bak". Если вы хотите получить именно "bak", в качестве второго аргумента fileparse используйте ' \.. *?'. Если передаваемое полное имя заканчивается разделителем каталогов (например, lib/), fileparse считает, что имя каталога равно "lib/", тогда как dirname считает его равным ".".

> Смотри также -------------------------------- Описание переменной $"0 в perlvar(1); документация по стандартному модулю File::Basename.

9.11. Программа: symirror

9.12. Программа: 1st

#!/usr/bin/perl
# 1st - вывод отсортированного содержимого каталогов
use Getopt::Std;
use File: Find;
use File: stat;
use User: pwent;
use User: grent;
getopts('lusrcmi') or die "DEATH;
Usage: $0 [-mucsril] [dirs ...] or
$0 -i [-mucsri] < filelist
Input format:
-i read pathnames from stdin Output format:
-1 long listing Sort on:
-m use mtime (modify time) [DEFAULT]
-u use atime (access time)
-c use clime (mode change time)
-s use size for sorting Ordering:
-r reverse sort
NB: You may only use select one sorting option at a time, DEATH
unless ($opt_i || @ARGV) { @ARGV = ('.') }
if ($opt_c + $opt_u + $opt_s + $opt_m > 1) {
die "can only sort on one time or size";
}
$IDX = 'mtime';
$IDX = 'atime' if $opt_u;
$IDX = 'ctime' if $opt_c;
$IDX = 'size' if $opt_s;
$TIME_IDX = $opt_s ? 'omtime' : $IDX;
*name = "File::Find::name; # Принудительное импортирование переменной
# Флаг $opt_i заставляет wanted брать имена файлов
# из ARGV вместо получения от find.
if ($opt_i) {
*name = *_; # $name теперь является синонимом
$_ while (о) { chomp; &wanted; } # Все нормально, это не stdin
} else {
find(\&wanted, @ARGV);
}
# Отсортировать файлы по кэшированным значениям времени,
# начиная с самых новых.
@skeys = sort { $time{$b} <=> $time{$a} } keys %time; # Изменить порядок, если в командной строке был указан флаг -r
@skeys = reverse @skeys if $opt_r;
for (@skeys) {
unless ($opt_l) { # Эмулировать Is -1, кроме прав доступа
print "$_\n";
next;
} Snow = localtime $stat{$J->$TIME_IDX();
printf "%6d %04o %6d %8s %8s %8d %s %s\n",
$stat{$_}->ino(), $stat{$_}->mode() & 07777,
$stat{$_}->nlink(), user($stat{$_}->uid()),
group($stat{$_}->gid()), $stat{$_}->size(), Snow, $ ;
}
# Получить от stat информацию о файле, сохраняя критерий
# сортировки (mtime, atime, ctime или size)
# в хэше %time, индексируемом по имени файла.
# Если нужен длинный список, весь объект stat приходится
# сохранять в %stat. Да, это действительно хэш объектов.
sub wanted {
my $sb = stat($_); # XXX: stat или Istat?
return unless $sb;
$time{$name} = $sb->$IDX(); # Косвенный вызов метода
$stat{$name} = $sb if $opt_l;
}
# Кэширование преобразований идентификатора пользователя в имя
sub user {
my $uid = shift;
$user{$uid} = getpwuid($uid)->name || "#$uid" unless defined $user{$uid};
return $user{$uid};
}
# Кэширование преобразований номера группы в имя
sub group {
my $gid = shift;
$group{$gid} = getgrgid($gid)->name || "#$gid" unless defined $group{$gid};
return $group{$gid};
}

© copyright 2000 Soft group