Вывод хеша в порядке вставки без использования Tie::IxHash
Без модуля Tie::IxHash вывод хеша в порядке вставки можно сделать при помощи дописывания числовой информации в хеш. Есть файл news.dat, который выводится скриптом в таком порядке, в каком данные занесены в файл. Необходимо удалить одновременно больше одной строчки из текста(не важно строка это, или разделитесь, это однозначно определяется переменной $/).
#!/usr/bin/perl -wT
use CGI 'param';
@del=param;
sub del{
pop @del; $mass=~s!"|&(.*?);!!g;
open F, "<news.dat" or die "Err: $!"; @mass=<F>; close F;
open F, ">news.dat";
foreach $un(@mass){ $as=$un; $i++; chomp $as;
$un=~s|(.*)new>(.*?)</a>(.*)\[(.*?)\]|$2$4|i;
$un=~s!"|&(.*?);!!g; chomp $un;
$u{"$un"}="$as#$i#\n";
}
foreach $del(@del){
$del=~s!"|&(.*?);!!g; chomp $del;
$terr="Link $u{$del} was deleted<p>\n" if (exists $u{"$del"});
$terr=~s!\d{8}|#(.*?)#!!ig;
print $terr; $terr="";
delete $u{$del} if (exists $u{"$del"});
}{ local $_;
while (($km, $_) = each %u){ push @tmp, "$u{$km}"}
}
@temp=grep{s/#(\d+?)#//}
map{ $_ -> [1]}
sort{$a->[0] <=> $b->[0]}
map{[/#(\d+?)#/, $_]}
grep{!$_{$_}++} @tmp;
print F reverse @temp;
close F;
}
Разъясним принцип работы скрипта. Исходная задача такова: на входе есть несколько checkbox из формы, в которых может быть поставлено больше одной галочки. Требуется найти и вычеркнуть отмеченные строчки. Файл news.dat модержит строки вида:
12345678<a href="lalalal">tra-ta-ta</a> [AAA]
чекбокс отмечается текстом tra-ta-ta, т.е. что-то вида
for ($i=$pos; $i<$pos+$n; $i++) {
$res[$i]=~s|^(\d\d\d\d)(\d\d)(\d\d)|$3\.$2\.$1 |;
print qq~<tr><td>$res[$i]</td><td>
<input type=checkbox name="$1$3" value="$1$3"></td></tr>~
if($res[$i]=~m!>(.*?)</a>(.*?)\[(.*?)\]!);
}
т.е. name="$1$3" value="$1$3" => name=tra-ta-ta&value=tra-ta-ta. Идея заключается в том, что элементы хеша можно пронумеровать в исходном порядке вставки, который будет исходным в силу того, что хеш определяется foreach, который последовательно читает данные из массива. поэтому говорим $i++; в цикле, ставим цифру в разделителе #\d+# и получаем на выходе хеш:
foreach $un(@mass){ $as=$un; $i++; chomp $as;
$un=~s|(.*)new>(.*?)</a>(.*)\[(.*?)\]|$2$4|i;
$un=~s!"|&(.*?);!!g; chomp $un;
$u{"$un"}="$as#$i#\n";
}
Дальше начинаем в хеше искать данные, которые передались через @del=param;
foreach $del(@del){
$del=~s!"|&(.*?);!!g; chomp $del;
$terr="Link $u{$del} was deleted<p>\n" if (exists $u{"$del"});
$terr=~s!\d{8}|#(.*?)#!!ig;
print $terr; $terr="";
delete $u{$del} if (exists $u{"$del"});
}
при помощи функции exists проводится проверка на наличие элемента в хеше. Итак, получили хеш с ключами, являющимися подстроками строк из файла news.dat, и значениями самих строк, т.е. в памяти точно лежит файл, превосходящий по размеру news.dat чуть меньше чем в два раза.
Далее идет вытаскивание значений из файла, уже без удаленных(было сравнение по подстроке):
{ local $_;
while (($km, $_) = each %u){ push @tmp, "$u{$km}"}
}
Замечательно, проверили, занесли в массив @tmp. Здесь локализация local $_; применена для того, чтобы убрать при использовании ключа -w лишнего warning из серверного лог-файла ошибок. Вытащили новый массив, который нужно соранить в файл news.dat. Теперь нужно убрать из массива @tmp повторяющиеся элементы, отсортировать по номерам #(\d+)#, убрать эти номера из элементов массива @tmp и сохранить массив в прежнем виде:
@temp=grep{s/#(\d+?)#//}
map{ $_ -> [1]}
sort{$a->[0] <=> $b->[0]}
map{[/#(\d+?)#/, $_]}
grep{!$_{$_}++} @tmp;
print F reverse @temp;
операция grep{!$_{$_}++} удаляет из массива повторяющиеся элементы, map{[/#(\d+?)#/, $_]} создает временный список анонимных массивов, которые затем сортируются sort{$a->[0] <=> $b->[0]}, затем map{ $_ -> [1]} приводит элементы массива в удобоваримый вид и grep{s/#(\d+?)#//} вырезает нуумерацию массива, оставшуюся от начального формирования хеша %u.
Далее оборачиваем конечный массив @temp функцией reverse и получам такой-же файл news.dat, только без элементов, отмеченных пользователем в чекбоксе.
Еще один вывод хеша в порядке вставки без использования приспособленных
для этого модулей:
my @qq = qw(a s d f g h j y f d e e t y u i v f s a e);
my @del = qw(f h u);
my (%to, %del, %exist);
map {$del{$_} = 1} @del;
for (my $i=$#qq; $i>=0; $i--){
if (!exists $exist{$qq[$i]}){
$exist{$qq[$i]} = 1;
$to{$i} = $qq[$i] unless(exists $del{$qq[$i]});
}
}
my @tmp;
foreach (sort{$a$b} keys %to){
push @tmp, $to{$_};
print "$to{$_}\n";
}
автор: Monax from
