Функции деления имени файла присутствуют в стандартном модуле File::Basename. Функции dirname и basename возвращают соответственно каталог и имя файла:
$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 полное имя и регулярное выражение для поиска расширения. Шаблон необходим из-за того, что расширения не всегда отделяются точкой. Например, что считать рас
$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; содержащаяся в ней строка идентифицирует текущую систему. Ее значение определяется в мо
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.6 рекурсивно воспроизводит каталог со всем содержимым и создает множество символических ссылок, указывающих на исходи ьи файлы.
Пример 9.6. symirror
#!/usr/bin/perl -w
# symirror - дублирование каталога с помощью символических ссылок
use strict;
use File::Find;
use Cwd;
my ($srcdir, $dstdir);
my $cwd = getcwd();
die "usage: $0 realdir mirrordir" unless @ARGV == 2;
for (($srcdir, $dstdir) = @ARGV) { my $is_dir = -d;
next if $is_dir; # Нормально
vif (defined ($is_dir)) {
die "$0: $_ is not a directory\n";
} else {
# Создать каталог
mkdir($dstdir, 07777)
or die "can't mkdir $dstdir: $!";
} } continue {
sft"(?!/)#$cwd/#;
# Исправить относительные пути
}
chdir $srcdir;
find(\&wanted, '.');
sub wanted {
my($dev, $ino, $mode) = lstat($_);
my $name = $File::Find::name;
$mode &= 07777;
# Сохранить права доступа
$name =" s!"\./!!;
# Правильное имя
if (-d _) {
# Затем создать каталог
mkdir("$dstdir/$name", $mode)
or die "can't mkdir $dstdir/$name: $!";
} else {
Продублировать все остальное
symlink("$srcdir/$name", v"$dstdir/$name")
or die "can't symlink $srcdir/$name to $dstdir/$name: $!
}
}
Вам не приходилось отбирать из каталога самые большие или созданные последними файлы? В стандартной программе Is предусмотрены параметры для сортировки содержимого каталогов по времени (флаг -t) и для рекурсивного просмотра подкаталогов (флаг -R). Однако
Следующая программа 1st справляется с этой задачей. Ниже показан пример подробного вывода, полученного с использованием флага -1:
% 1st -1 /etc 12695 0600 1 root wheel 512 Fri May 29 10:42:41 1998
/etc/ssh_random_seed 12640 0644 1 root wheel 10104 Mon Hay 25 7:39:19 1998
/etc/ld.so.cache 12626 0664 1 root wheel 12288 Sun May 24 19:23:08 1998
/etc/psdevtab 12304 0644 1 root root 237 Sun May 24 13:59:33 1998
/etc/exports 12309 0644 1 root root 3386 Sun May 24 13:24:33 1998
/etc/inetd.conf 12399 0644 1 root root 30205 Sun May 24 10:08:37 1998
/etc/sendmail.cf 18774 0644 1 gnat perldoc 2199 Sun May 24 9:35:57 1998
/etc/Xn/XMetroconfig 12636 0644 1 root wheel 290 Sun May 24 9:05:40 1998
/etc/mtab 12627 0640 1 root root 0 Sun May 24 8:24:31 1998
/etc/wtmplock 12310 0644 1 root tchrist 65 Sun May 24 8:23:04 1998
/etc/issue
Файл /etc/X11/XMetroconfig оказался посреди содержимого /etc, поскольку листинг относится не только к /etc, но и ко всему, что находится внутри каталога.
К числу поддерживаемых параметров также относится сортировка по времени последнего чтения вместо записи (-и) и сортировка по размеру вместо времени (-s). Флаг -i приводит к получению списка имен из стандартного ввода вместо рекурсивного просмотра каталога
Исходный текст программы приведен в примере 9.7.
Пример 9.7. 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};
}
