Зачастую, простые решения не привлекают к себе должного внимания. Но несколько строк кода, порой самого примитивного, могут защитить вас от множества проблем. Не так давно, на сайте было предложено решение задачи файлового мониторинга для Windows NT посредством XSUB и функций WinAPI (см. ). Речь шла о слежении в реальном времени. Что и говорить, решение было не из простых. Не все работали с Windows API, да и XSUB в реальной жизни применяется относительно редко. Ну а кто мешает решить проблему, как говорится, в лоб?
В UNIX-ах есть замечательная утилита find. Есть она и в Windows, но реализована там она по-другому и не обладает такой гибкостью, как UNIX-овый вариант. Может быть и с помощью виндовозовской find можно построить список файлов, но я, после пары неудачных попыток, бросил это неблагодарное дело (даже документации по командам в винде нет :( ) и решил реализовать построение списка файлов с помощью обожаемого perl. Изначально я предполагал, что скрипт будет работать довольно медленно из-за большого количества файлов и глубокой рекурсии, но... Я был приятно удивлен. Список всех файлов, после установки основных пакетов, был построен исключительно быстро (что не может не радовать :). Так вот, что бы иметь больший контроль над системой и точно знать что и куда было установлено (для каких целей, думаю объяснять не нужно), я написал два простеньких скрипта эффективный объем кода которых составил не более страницы. Перед каждой установкой я собираюсь выполнять сканирование файловой системы с целью построения первого списка для сравнения. После установки какого-либо нового пакета - строить еще один список, после чего буду сравнивать оба списка с целью выявления несоответствий. Этот список в последствии поможет мне вычистить все файлы оставшиеся от пакета. Вот такое простое решение (у юниксоидов оно наверное уже в генах :).
Можно подумать, а зечем в винде это нужно, ведь программы инсталляции сами выгребают после себя весь мусор? Да, если вы доверяете какому то там дядечке, написавшему неизвестно какой софт, который и тестировался только в пределах их компании, то не нужно. Лично я вообще никаким дядечкам не доверяю, и предпочитаю знать что, где и почему оно там лежит. В любом случае, если вы программируете по-настоящему, то набирать каждый раз при установки нового пакета всего три команды вас не затруднит (должны привыкнуть уже клацать по клавке :).
Итак решения просты и практически не заслуживают рассмотрения. Сначала приведу код программы, выполняющей построение списка файлов.
#!C:/perl/bin/perl -w # filelist.pl # Usage: filelist.pl path # For more information see http://whirlwind.ru/give/?oid=107#filelist use strict; use lib "C:/ROUTINES/LIB"; use pager qw/&die &warn/; use vars qw/$dir $path/; ProcessDir($ARGV[0] ? "$ARGV[0]\\" : ''); sub ProcessDir{ local $path = shift; $path = '' unless defined($path); local $dir; opendir($dir,$path) or warn "opendir $path failed: $!\n"; while (my $file = readdir($dir)){ next if $file =~ /^\./; ProcessDir("$path$file\\") if -d "$path$file"; print "$path$file\n"; } closedir($dir); return; }
По поводу
use lib "C:/ROUTINES/LIB"; use pager qw/&die &warn/;
вы должны знать. Помните админский пейджер (см. )? Так вот, что, зря мы его писали? Я его очень даже повсеместно юзаю на всех серверах. Честно говоря, лучше похвалы нет, когда ИД, после моего появления на рабочем месте, докладывает, мол, а что это там у тебя пищит? А это, отвечаю, кул-система-контроля-выполнения-поставленных-задач! После чего ИД разводит руками - ну круто! - и возвращается в свой кабинет с думами о повышении моей ЗП :) Если вы пейджер не юзаете и юзать ни в какую не хотите, то просто выкиньте эти строки из кода.
Пожалуй, в этом коде может возникнуть вопрос по хендлеру каталога. Объясняю. Файловый хендлер, это то же самое что и скалярная переменная. Я имею в виду, что на нее распространяются те же правила и ограничения, что и на имена других переменных. Но, strict на них не действует так же как и на переменные. По этому, любой файловый хендлер считается глобальным, если не указано обратное. Представьте что будет, если мы, в процессе перебора файлов каталога, рекурсивно шагнули вглубь? То то и оно, что дескриптор переоткроется с целью сканирования вложенной директории, а после возврата из рекурсивного вызова мы получим непонятно что, но никак не тот дескриптор, который был до вызова. Вот из-за таких пирогов, мы объявляем хендлер локальной переменной. Вообще, честно говоря, можно и хендлер и переменную $path объявить как my, оно и быстрее будет.
Ну и второй скрипт не менее простой.
#!C:/perl/bin/perl -w # listcomp.pl # Usage: listcomp.pl listfile1 listfile2 # For more information see http://whirlwind.ru/give/?oid=107#listcomp # use strict; use lib "C:/ROUTINES/LIB"; use pager qw/&die &warn/; use vars qw/%list2 $file/; if (!$ARGV[0] || !-f $ARGV[0] || !$ARGV[1] || !-f $ARGV[1]){ die "Usage: listcomp.pl listfile1 listfile2\n"; } open F,$ARGV[1] or die "open $ARGV[1] failed: $!\n"; $list2{(chomp,$_)[1]} = 1 while <F>; close F; open F,$ARGV[0] or die "open $ARGV[0] failed: $!\n"; while (<F>){ chomp; print "$_\n" unless exists($list2{$_}); delete($list2{$_}); } print join "\n",keys(%list2);
Подразумевается, что первый, это ранее созданный список. Соответственно второй - это тот, который был создан позднее. Работает это все по следующему принципу. Сначала на основе первого списка строится хэш, в котором ключи представлены именами файлов. После того как хэш построен, из первого файла построчно считываются имена файлов. Если в хэше отсутствует файл, который прочитан из первого списка, то это означает что на момент создания второго списка этот файл отсутствовал (и.г. был удален). Мы выводим имя такого файла на печать. После того, как все файлы из первого списка будут обработаны в хэше останутся только те файлы, которых не было на момент создания первого списка. Иначе говоря, оставшиеся ключи хэша и будут теми файлами, которые были добавлены. Список таких файлов то же выводится на печать.
Таким образом, перехватывая вывод от программы, мы построим список файлов, которые были либо добавлены, либо удалены. Вот кусок списка, который построила программа на основе списков до и после установки модуля DBD-Mysql.
Программа fileex.pl позволит вам вытворять с файлами разнообразные операции. По аналогии с встроенной функцией map, fileex позволяет комплексно обрабатывать файлы. Давайте сначала взглянем на код
#!C:/perl/bin/perl -w # fileex.pl # Usage: fileex.pl path expr true_cmd [false_cmd] # For more information see http://whirlwind.ru/give/?oid=107#fileex # " = 34 = %22 # % = 37 = %25 # \ = 92 = %5C use strict; use vars qw/$dir $path $expr $tru $fal $debug/; if (@ARGV < 3){ print 'fileex.pl v0.1 For more information see http://whirlwind.ru/give/?oid=107 Usage: fileex.pl path expr true_cmd [false_cmd] Examples: fileex.pl C:\TMP "-M $f > 7" "DEL /F /Q $f" fileex.pl C:\WINCMD $s=~/.*?\.dll/i "echo $s" '; exit(1); } ($path,$expr,$tru,$fal) = @ARGV; ProcessDir($ARGV[0] ? "$ARGV[0]\\" : ''); exit(0); sub ProcessDir{ local $path = shift; $path = '' unless defined($path); local $dir; opendir($dir,$path) or warn "opendir $path failed: $!\n"; while (my $s = readdir($dir)){ if (-f "$path$s"){ my $f = "$path$s"; undef @_; my $r = eval $expr; die @_ if @_; my $cmd = $fal; $cmd = $tru if $r; next unless $cmd; $cmd = eval '"'.$tru.'"'; $cmd =~ s/%(..)/pack("C",hex($1))/eg; system $cmd; }elsif(-d "$path$s" && $s ne "." && $s ne ".."){ ProcessDir("$path$s\\"); } } closedir($dir); return; }
Как видите, основа прежняя: программа перебирает файлы указанного каталога, рекурсивно углубляясь в иерархию субдиректорий.
Программа требует, по крайней мере, трех аргументов. Первый, как и в предыдущих решениях, указывать на стартовую директорию. Второй аргумент является выражением на Perl, которое определяет какое из двух доступных действий выполнять для очередного файла. Далее следует системная команда, которая будет выполняться для всех файлов, для которых верно утверждение expr (то есть после вычисления выражения получили какое либо истинное значение). Последний аргумент может быть опущен - он определяет команду, которую необходимо выполнять если расчет выражения вернул ложь. Если этот аргумент не указывать, программа не будет выполнять никаких лишних телодвижений. Хочу заметить, что последние два аргумента, в отличии от условия, представляют собой команды операционной системы. Так как обычно такие команды требуют дополнительной аргументации не забывайте группировать их с помощью двойных кавычек.
В процессе аргументации вы можете использовать специальные переменные: $s - имя файла и $f - полное имя файла. Благодаря тому, что на каждой итерации условие проверяется посредством eval, эти переменные можно интерполировать прямо в условие. Но не забывайте, если ваше условие описано с пробелами, вы должны ограничить его кавычками. В системных командах вы так же можете использовать значения переменных $f и $s.
Ну, а теперь несколько примеров использования программы fileex. Предположим, у нас есть каталог для пользовательских помоев. То есть все кому не лень скидывают в этот каталог файлы, которые, естественно, удалять никто не собирается. Таким образом мы имеем здоровенный резервуар бесцельно растрачиваемых ресурсов. За-то теперь с помощью всего одного запуска программы мы избавимся от устаревших файлов (точнее, время последней модификации которых более 14 дней).
Я не разрешаю пользователям хранить исполняемые (.exe) файлы в пользовательских каталогах. Мне кажется с хранением софта прекрасно справляются специальные сервера. То же самое касается файлов .mp3. Следующие команды распихивают соответствующие файлы по местам
Обратите внимание, на модификатор i в условии. Хотя регистр для имен файлов в операционных системах Windows не различается, имена все равно хранятся в том регистре, в котором их задали при создании. В связи с этим, в процессе обработки могут встретится расширения в различных (или даже смешанном) регистрах. Именно что бы Perl не обращал внимания на эти отличия, мы и используем модификатор i. Обратите внимание так же на то, как задаются пути в командах. Дело в том, что системные команды Windows в упор не признают путей, содержащих символ / в качестве разделителя. По этому вы должны использовать форму записи путей, принятую в Windows. Так как символ \ в строках является признаком спецсимвола, то для записи мы должны использовать двойной слэш. В процессе интерполяции переменных $f и $s путь будет приведен в требуемый вид.
Нашу новоиспеченную программу можно так же использовать и для построения списка файлов (вместо filelist)
fileex.pl E:\USERS 1 "echo $f" > files.txt
Однако, в список не будут попадать директории. Хотя... Я думаю вы достаточно освоились с предметом что бы изменить программу самостоятельно.
Однако, как ни хороша наша программа, есть и проблемы. Лично мне так и не удалось написать пакетные файлы для периодической обработки некоторых каталогов. Я не смог указать пути к каталогам, в именах которых присутствуют символы кириллицы. Пришлось выкручиваться, опять таки, с помощью Perl. Я написал очень простой скрипт, который последовательно выполняет запуск системных команд с любыми путями. Вы можете использовать эту технологию для облегчения своей админской жизни вообще по любому "пакетному" поводу (я не стал приводить примеры команд в связи с их чрезмерной длиной)
my @commands = split("\n",' ... команды ... '); foreach my $cmd (@commands){ next unless $cmd; system($cmd); }
Однако, хотя мы и избавляемся от проблемы с кириллицей, этот метод то же имеет свои недостатки. Взгляните на пример
Эта часть строки (условная команда - 3 аргумент для fileex) чрезмерно перегружена слэшами. А все из-за того, что здесь нужно учитывать двойную интерполяцию: первый раз - непосредственно в программе, а второй - в момент обработки условной команды программой fileex. Быть может более приемлимым способом будет хранение пакета в отдельном файле. А для выполнения таких файлов можно написать простейшую программу execbat.pl... Ну, думаю, смысл вам понятен.
Однако проблемы с кириллицей в путях это еще не все. Существует так же проблема наличия в путях "глюкавых" символов. Чаще всего встречаются пробелы, а так же другие спецсимволы, которые обрабатываются конвеером определенным образом. При первом же поиске mp3 файлов программа столкнулась с проблемой амперсанда. Итак, давайте подробнее рассмотрим проблему. Взгляните еще раз на аргумент программы fileex
Представьте что переменная $f или $s содержит пробелы(для примера возьмем $f = "C:\путь\мой документ.doc", а $s, соотв. = "мой документ.doc"). После интерполяции мы получим такую строку
Глядите, эта команда содержит уже не четыре, а шесть аргументов. Соответственно, ошибочным будет и результат выполнения - программа COPY просто не найдет файл "C:\путь\мой", который она посчитает за источник. Самое обидное, что мы не можем выделить аргументы команды COPY с помощью кавычек. Такая запись будет неверно воспринята командным интерпретатором - он посчитает, что это кавычка, закрывающая предыдущий аргумент. И если по отношению к $f мы можем заставить fileex интерполировать сразу с кавычками, то с переменной $s такая фича не прокатит (опять же обратитесь к примеру, и представьте что получится). Как один из выходов из данной ситуации можно предложить способ кодирования URL - то есть с помощью шестнадцатеричного кода, предваренного символом процента %. После этого нужно изменить программу fileex так, что бы она, после получения третьего и четвертого аргументов, предварительно енкодила их.
Посмотрите, как решается данная проблема в программе. Заметьте что команда енкодится непосредственно перед вызовом system, в противном случае предшествующий вызов eval будет часто спотыкаться об эти самые кавычки и прочие спецсимволы. Кстати, вместе с появлением кавычек исчезла проблема амперсанда. В качестве подсказки можете глянуть первые строки программы. Там я привел коды нескольких самых необходимых спецсимволов. Если у вас еще остались кое-какие непонятки, гляньте на пример ниже
Это кусок командной строки, в которой представлены условие и команда выполняющаяся при истинном условии. Символ слеша заменен комбинацией %5C, а двойные кавычки - %22.
Изменения
2003-04-07
Решена проблема спецсимволов
Немного оптимизирован блок обработки файлов
Хочу вам представить еще одну не менее полезную утилиту, выполняющую репликацию двух или более каталогов. Программа replicate.pl принимает в качестве аргументов пути к каталогам, структуру и содержание которых необходимо реплицировать между собой. Логично предположить, что для такой операции требуется по крайней мере два каталога. Программа поочередно обходит все указанные каталоги, по ходу дела пополняя список уже проверенных файлов и каталогов. Отсутствующие каталоги автоматически создаются. Для файлов находятся контрольные суммы, которые в последствии сравниваются. Если контрольные суммы не совпадают, то выбирается тот файл, который был модифицирован последним. Эта копия и раскидывается по оставшимся каталогам-участникам репликации. Подобный подход является довольно дорогостоящим в плане потребления машинных ресурсов, по этому я не советую сильно на него рассчитывать в целях репликации каких бы то ни было мультимедийных файлов. Однако, для небольших файлов подобное решение прекрасно подходит. Вот я, например, содержу на каждом сервере специальную папку со скриптами. Вы уже наверное заметили что это папка C:\ROUTINES. Однако, имея дурную привычку редактировать программы на первом же попавшемся сервере, в последствии бывает очень трудно найти наиболее свежую версию библиотеки или какого-нибудь скрипта. Но выполняя ежедневную репликацию каталогов C:\ROUTINES\LIB и C:\ROUTINES\BIN на всех серверах можно позабыть об этих проблемах (главное не изменять в один день на разных серверах).
ЗЫ. Исходный код не совсем аккуратен, особенно функция CheckFile... Будем считать это бета-версией :)
#!C:/perl/bin/perl -w # replicate.pl # Usage: replicate.pl path1 path2 [path3...] # For more information see http://whirlwind.ru/give/?oid=107#replicate use strict; use Win32; use Digest::MD5; use vars qw/$dir %proc $err/; if (@ARGV < 2){ print 'replicate.pl v0.1 For more information see http://whirlwind.ru/give/?oid=107 Usage: replicate.pl path1 path2 [path3...] '; exit(1); } foreach my $path (@ARGV){ ProcessDir($path,''); } exit($err ? 0 : 1); sub ProcessDir{ my ($ncp,$adp) = @_; local $dir; unless (opendir($dir,"$ncp\\$adp")){ warn "opendir $ncp\\$adp failed: $!\n"; return undef; } while (my $s = readdir($dir)){ if (-f "$ncp\\$adp\\$s"){ CheckFile($ncp,"$adp\\$s"); }elsif(-d "$ncp\\$adp\\$s" && $s ne "." && $s ne ".."){ next unless CheckDir($ncp,"$adp\\$s"); ProcessDir($ncp,"$adp\\$s"); } } closedir($dir); return 1; } sub CS{ my $file = shift; my $md5 = Digest::MD5->new; if (-f $file){ unless(open(FILE,$file)){ warn "CheckSum: $!"; return undef } binmode FILE; $md5->addfile(*FILE); close FILE; }else{ return 0 } $md5->b64digest } sub CheckDir{ my ($ncp,$path) = @_; return 1 if exists($proc{$path}); foreach my $dir (@ARGV){ unless (-d $dir){ warn "Directory $dir not exists!\n"; $err = 1; next } next if $dir eq $ncp; next if -d "$dir$path"; unless (mkdir("$dir$path",0755)){ warn "mkdir $dir$path failed: $!\n"; $err = 1; return undef }else{ print "Create: $ncp$path -> $dir$path\n"; } } $proc{$path} = 1; return 1 } sub CheckFile{ my ($ncp,$file) = @_; return 1 if exists($proc{$file}); my ($i,@fcs); for ($i = 0; $i < @ARGV; $i++){ my $dir = $ARGV[$i]; unless (-d $dir){ warn "Directory $dir not exists!\n"; $err = 1; next } unless (-f "$dir$file"){ $fcs[$i] = ""; next; } unless ($fcs[$i] = CS("$dir$file")){ warn "CS failed: $dir$file\n"; $err = 1; } } my $find = 0; my ($cs,$discr); for ($i = 0; $i < @ARGV; $i++){ next unless $fcs[$i]; $cs = $fcs[$i]; last } unless ($cs){ warn "Panic: CS not found\n"; $err = 1; return undef } for ($i=$i; $i < @ARGV; $i++){ next if $cs eq $fcs[$i]; $discr = 1; last } my @tm; undef $discr; for ($i = 0; $i < @ARGV; $i++){ next unless $fcs[$i]; next unless -d $ARGV[$i]; if (!$discr || -M "$ARGV[$i]$file" < $discr){ $discr = -M "$ARGV[$i]$file"; $find = $i; } } for ($i = 0; $i < @ARGV; $i ++){ next if $i == $find; next if $fcs[$i] eq $fcs[$find]; next unless $fcs[$i]; my ($src,$dst) = ($ARGV[$find],$ARGV[$i]); unless( Win32::CopyFile("$src$file","$dst$file",1)){ warn Win32::FormatMessage(Win32::GetLastError())."\n"; $err = 1; }else{ print "Update: [$fcs[$find]]$src$file -> ", "[$fcs[$i]]$dst$file\n"; } } for ($i = 0; $i < @ARGV; $i++){ next if $fcs[$i]; my ($src,$dst) = ($ARGV[$find],$ARGV[$i]); unless( Win32::CopyFile("$src$file","$dst$file",1)){ warn Win32::FormatMessage(Win32::GetLastError())."\n"; $err = 1; } else{ print "Copy: $src$file -> $dst$file\n"; } } $proc{$file} = 1; return 1; }