Имеется файл данных, поля которого разделены запятыми. Однако в полях могут присутствовать свои запятые (находящиеся внутри строк или снабженные служебными префиксами). Многие электронные таблицы и программы для работы с
базами данных поддерживают списки полей, разделенных запятыми, в качестве стандартного формата для обмена данными.
Решение
Воспользуйтесь следующей процедурой:
sub parse_csv {
my $text = shift; # Запись со значениями, разделенными запятыми my @new = ();
push(@new, $+) while $text =~ m{
# Первая часть группирует фразу в кавычках
"([^\"\\]*(?:\\.[^\"\\]*)*)",?
| (^,]+),?
| ,
}QX;
push(@new, under) if substr($text,-1,1) eq ',';
return @new; # Список значений, которые разделялись запятыми }
Также можно воспользоваться стандартным модулем Text:ParseWords:
use Text::ParseWords;
yub parse_csv {
return quoteword(",",0, $_[0],
}
Комментарий
Ввод данных, разделенных запятыми, - коварная и непростая задача. Все выглядит просто, но в действительности приходится использовать довольно сложную систему служебных символов, поскольку сами поля могут содержать внутренние запятые. В результате подстано
К счастью, модуль Text::ParseWords скрывает от вас все сложности. Передайте функции qoutewords два аргумента и строку разделенных данных. Первый аргумент определяет символ-разделитель (в данном случае - запятая), а второй - логический флаг, который показы
Если кавычки должны присутствовать внутри поля, также ограниченного кавычками, воспользуйтесь префиксом \: "like \"this\". Кавычки, апострофы и обратная косая черта - единственные символы, для которых этот префикс имеет специальное значение. Все остальные
Ниже показан пример использования процедуры parse_csv. q<> - всего лишь хитроумный заменитель кавычек, благодаря которому нам не придется расставлять повсюду символы \.
Имеются две английские фамилии. Требуется узнать, звучат ли они похожим образом (независимо от написания). Это позволит выполнять неформальный поиск в телефонной книге, в результатах которого наряду со Smith будут присутствовать и другие похожие имена - н
Алгоритм soundex хэширует слова (особенно английские фамилии) в небольшом пространстве с использованием простой модели, имитирующей произношение по правилам английского языка. Грубо говоря, каждое слово сокращается до четырехсимвольной строки. Первый симв
Следующая программа предлагает ввести имя и ищет в файле паролей имена с похожим звучанием. Аналогичный подход может использоваться для баз данных имен, поэтому при желании можно индексировать базу данных по ключам soundex. Конечно, такой индекс не будет
> Смотри также
Документация по стандартным модулям Text::Soundex и User::pwent; man-страница passwd(S) вашей системы; "Искусство программирования", том 3, глава 6.
Программа из примера 1.4 представляет собой фильтр, который заменяет все встречающиеся в тексте слова из первого столбца соответствующими элементами второго столбца.
При вызове без файловых аргументов программа выполняет функции простого фильтра. Если в командной строке передаются имена файлов, то в них помещаются результаты, а прежние версии сохраняются в файлах с расширениями *.orig (см. рецепт 7.9). При наличии пар
Таблица пар "исходное слово/заменитель" хранится в основной программе, начиная с __END__ (см. рецепт 7.6). Каждая пара преобразуется в подстановку и накапливается в переменной $code так же, как это делается в программе popgrep2 из рецепта 6.10.
Параметр -t выводит сообщение об ожидании ввода с клавиатуры при отсутствии других аргументов. Если пользователь забыл ввести имя файла, он сразу поймет, чего ожидает программа.
Пример 1.4. fixstyle
#!/usr/bin/peri -w
# fixstyle - замена строк секции парными строками
# использование: $0 [-v] [файлы...]
use strict;
my $verbose = (@ARGV && $ARGV[0] eq '-v' && shift);
if (@ARGV) {
$"I = ".orig"; # Сохранить старые файлы }
else {
warn "$0: Reading from stdin\n" if -t STDIN;
}
my $code = "while (<>) {\n";
# Читать данные и строить код для eval
while () {
chomp;
my ($in, $out) = split /\s*=>\s*/;
next unless $in && $out;
$code .= "s{\\0$in\\E}{$out}g";
$code .= "&& printf STDERR qq($in => $out at \$ARGV line \$.\\n)' if $verbose;
$code .= ";\n";
} $code ,= "printf;\n}\n";
eval "{ code } 1" 11 die;
_-END__
analysed => analyzed
built-in => builtin
chastized => chastised
commandline => command-line
de-allocate => deallocate
dropin => drop-in
hardcode => hard-code
meta-data => metadata
multicharacter => multi-character
multiway => multi-way
non-empty => nonempty
non-profit => nonprofit
non-trappable => nontrappable
pre-define => predefine
preextend => pre-extend
re-compiling => recompiling
reenter => re-enter
turnkey => turn-key Небольшое предупреждение: программа работает быстро, но не в тех случаях, когда количество замен измеряется сотнями. Чем больше секция DATA, тем больше времени потребуется. Несколько десятков замен не вызовут существенного замедления. Более того, для
В примере 1.5 приведена следующая версия программы. При малом количестве замен она работает медленнее, а при большом - быстрее.
Пример 1.5. fixstyle2
#!/usr/bin/perl -w
# fixstyle2 = аналог fixstyle для большого количества замен
use strict;
my $verbose = (@ARGV && $ARGV[0] eq '-v' && shift);
my $change = ();
while () {
chomp;
my ($in, $out) = split /\s*=>\s*/;
next unless Sin && $out;
$change{$in} = $out;
}
if (@ARGV) {
$"I = ".orig";
} else {
warn "$0: Reading from stdin\n" if -t STDIN;
}
while (<>) { my $i =0;
s/"(\s+)/7 && print $1; # Выдать начальный пропуск
for (split /(\s+)/, $_, -1) {
print( ($i++ & 1) ? $_ : ($change{$_} || $_));
}
}
В новой версии программы каждая строка разбивается на пропуски и слова (относительно медленная операция). Затем слова используются для поиска замены в хэше, что выполняется существенно быстрее подстановки. Следовательно, первая часть работает медл
Если бы мы не старались сохранить количество пропусков, разделяющих слова, нетрудно сделать так, чтобы вторая версия не уступала первой по скорости даже при небольшом количестве замен. Если вам хорошо известны особенности входных данных, пропуски можн
# Работает очень быстро, но со сжатием пропусков
while (<>) {
for (split) {
print $change{$_} | $_, " ";
}
print "\n";
}
В конце каждой строки появляется лишний пробел. Если это нежелательно, воспользуйтесь методикой рецепта 16.14 и создайте входной фильтр. Вставьте следующий фрагмент перед циклом while, сжимающим пропуски:
my $pid = open(STDOUT, "|=");
die "cannot fork: $!" unless defined $pid;
unless ($pid) {
while () { s/ $//;
print;
} exit;
}
