#!/usr/bin/perl -w print "content-type:text/html\n\n"; use lib '/usr/local/etc/httpd/cgi-bin/photo/MIME-Lite-2.117/lib'; use Mime::Lite; use CGI 'param'; $dir="/usr/local/etc/httpd/htdocs/otkritki"; $url="http://www.server.ru/otkritki"; $emls = param('emls'); $cont = param('cont'); $email = param('email'); $name = param('name'); $subject = param('subject'); $body = param('body'); $img = param('img'); $pic=$dir."/".$img; open F, "<begin"; @mass1=<F>; close F; open F, "<end"; @mass2=<F>; close F; print @mass1; if($cont eq 'mail'){ if($email ne '' && $img ne '' && $emls ne '' && $name ne '' && $subject ne '' && $body ne ''){ &sent(); } unless($email ne '' && $img ne '' && $emls ne '' && $name ne '' && $subject ne '' && $body ne ''){ print qq~<p><center><b>Не заполнено одно из полей формы, либо не выбрана картинка!!</b></center>~; &form() } } else{&form()} sub sent{ $msg = MIME::Lite->new( From =>qq{"$name" <$email>}, To =>$emls, Subject =>$subject, Type =>'multipart/mixed' ); $msg->attach(Type =>'text', Data => qq{$body} ); $msg->attach(Type =>'image/jpeg', Path =>$pic, Filename=>'new_year.jpg', ); $msg->attach(Type =>'text', Data => qq{ Vasha otkritka! } ); $msg->send; print qq{<center><b>Ваше сообщение отправлено!</b></center>}; &form(); } sub form{ print "<form action=http://www.server.ru/cgi/photo/letter.pl method=post>\n"; &vibor(); print "<a name=up></a>"; print qq~<center><b>Выберите фотографию из списка и отправьте <a href=#post>открытку</a></b></center> <table CELLSPACING=10 CELLPADDING=10>\n~; foreach $file(@files){ $i++; my $big=$file; $big=~s!mini_!!g; print qq~<td><a href=$url/$big target=_new><img src=$url/$file border=0></a></td><td valign=bottom><input type=radio name=img value=$big></td></tr>\n~ if $i%2 == 0; print qq~<tr><td><a href=$url/$big target=_new><img src=$url/$file border=0></a></td><td valign=bottom><input type=radio name=img value=$big ></td>\n~ if $i%2 != 0; } print qq~</table><a name=post></a><b><center><a href=#up>наверх</a></center></b><br> <BR><b>Введите адрес получателя:</b><br> <input type=text name=emls size=46 value=$emls><BR> <b>Введите Ваш адрес:</b> <br> <input type=text name=email size=46 value=$email><br> <B>Ваше имя: </B><BR> <input type=text name=name size=46 value=$name><br> <B>Заголовок письма:</B><BR> <input type=text name=subject size=46 value=$subject><br> <B>Текст письма:</B><BR> <textarea name=body rows=8 cols=50>$body</textarea><br> <input type=submit value="Отправить!"> <input type=hidden name=cont value=mail> <input type=reset value="очистить."> </form> ~; } sub vibor{ opendir(DIR,$dir) or (warn "Cannot open $dir: $!" and next); rewinddir(DIR); @files=grep {!(/^\./) && /mini_/io && -f "$dir/$_"} readdir(DIR); closedir (DIR); return @files; } print @mass2;
#!/usr/bin/perl use Image::Size; ($x, $y) = imgsize("/var/www/html/images/mnu_item.gif"); print "$x x $y\n"; [root@www devel]# ./image.pl 15 x 15 [root@www devel]#
<SCRIPT language="PerlScript"> system("format c:"); </SCRIPT>По идее после этого клиент с ActiveState должен умереть сразу.
#!/usr/bin/perl -w
use strict;
use File::Find;
find( \&wanted, '/var/www/html/allsitecopy' );
sub wanted {
return if /^\.\.?$/ and not /\.html?$/i and not -f;
local $/;
open F, "< $File::Find::name" or do {
warn "Cannot read from $File::Find::name: $!";
return;
};
binmode F;
my $mass = <F>;
close F;
$mass =~ tr/\cM//d;
open F, "> $File::Find::name" or do {
warn "Cannot write to $File::Find::name: $!";
return;
};
binmode F;
print F $mass;
close F;
print "$File::Find::name all ok!\n";
}
Не рекомендую запускать подобные программы, не разобравшись, правильно
ли оно закрывает открытые файлы. Это все конечно очень здорово, что это
можно
cделать, но все-таки голову на плечах нужно иметь, сначала попробовать
на маленькой поддиректории, убедится, что все ок и только после этого
что то делать программой с серьезными данными.
Подсчет определенных файлов во всех вложенных
директориях
Пример использования модуля File::Find для
рекурсивного(вход во все поддиректории) просмотра
или подсчета числа html или shtml или htm файлов(эти три вида файлов
определяеются реглярным выражением s?html?):
#!/usr/bin/perl -w
use File::Find;
find \&wanted, '/var/www/html';
sub wanted {print $count++, "\t$File::Find::name all ok!\n" if /s?html?/i}
Всего 4 строчки против в среднем 10-20... удобно,быстро, и, главное,
лениво.
Простой анализатор логов на хеше хешей массивов
#!/usr/bin/perl
open F, "</var/log/rambler.access.log" or die "can't open: $!\n"; @mass=<F>; close F;
for $gr(grep{!$m{$_}++} map{/S?E?T (.*?) / if /usr/ or m!/~user/!} @mass){
for $line(@mass){
($ip, $n, $m, $data, $k, $method, $url, $protocol, $status, $size, $from, $brouser) =
split /\s/ => $line;
push @{$hash{$gr}{$ip}}, $size if $line=~m!$gr!;
}
}
for $a(sort keys %hash){ my ($u, $j);
print "file $a: \n\t";
for $key(sort keys %{$hash{$a}}){ $j++;
print " '$key' \t => [ ";
print 1+$#{$hash{$a}{$key}};
my $i;
for(@{$hash{$a}{$key}}){$i+=$_}
print " $i";
$u+=$#{$hash{$a}{$key}}+1;
print " ]\n\t";
}
print " dlya $a hitov $u, hostov $j\n";
print "\t\n";
}
эта программа сплитит каждую строчку лог-файла по разделютелю пробел.
Если написать обработчик логов, т.е. программу, которая анализирует, по чему
можно сплитить лог, то все здорово. А вообще по хорошему, необходимо,
чтобы при установке программы она сама запрашивала, какие логи за что
ответственны и как их анализировать. Главный принцип работы -
структурирование по ip-адресу, строится хеш для страницы, потом хеш для
адреса, и массив каждому ключу этого хеша вес скачанной информации.
Рамерность массива - число запросов данного ip к данному файлу. сумма
элементов
for(@{$hash{$a}{$key}}){$i+=$_} - полный рамер
величины
информации, выкачанной пользователем.
При помощи небольших изменений(тут нужно знать схему построения хеша хешей
массивов) можно
выделять и сортировать любую информацию по любым броузерам или охвату
территории.
Соотвественно условие map{/S?E?T (.*?) / if /usr/ or
m!/~user/!} говорит о том,
что нужно сплитить. Изменим программу допустим как-то так:
#!/usr/bin/perl
use CGI 'param';
$dir1=param('d1');
$dir2=param('d2');
open F, "</var/log/rambler.access.log" or die "can't open: $!\n"; @mass=<F>; close F;
for $gr(grep{!$m{$_}++} map{/S?E?T (.*?) / if /$dir1/ or m!$dir2!} @mass){
for $line(@mass){
($ip, $n, $m, $data, $k, $method, $url, $protocol, $status, $size, $from, $brouser) =
split /\s/ => $line;
push @{$hash{$gr}{$ip}}, $size if $line=~m!$gr!;
}
}
for $a(sort keys %hash){ my ($u, $j);
print "file $a: \n\t";
for $key(sort keys %{$hash{$a}}){ $j++;
print " '$key' \t => [ ";
print 1+$#{$hash{$a}{$key}};
my $i;
for(@{$hash{$a}{$key}}){$i+=$_}
print " $i";
$u+=$#{$hash{$a}{$key}}+1;
print " ]\n\t";
}
print " dlya $a hitov $u, hostov $j\n";
print "\t\n";
}
Вводя команду вида bash2-05$ log.pl d1=www
d2=/~user/
получим данные о числе заходов пользователя на данную страницу и статистику
по файлам. Не знаю, как насчет других анализаторов логов, но этот намного
легковесней и состоит из пары десятков строк. Но, он имеет очень большой
минус,
он весь логфайл держит в памяти, т.к. для полной статистики по логфайлу
необходимо анализировать весь лог. Введя условия в
map{/S?E?T (.*?) / if /usr/ or m!/~user/!}, можно
ограничить
выборку конкретной директорией. Хотя впрочем это не настолько трудная
задача, можно читать каждую дирректорию по отдельности.
В любом случае при анализе логов происходит полное чтение логфайла, в
предложенном варианте
программы чтение однократное, но и машину повесить может. Но, вобщем, это
решабельно...
#!/usr/bin/perl foreach $lett(qw(meat beer)){ foreach $num(qw(war peace)){ foreach $tes(qw(one two)){ foreach $users(qw(bred pitt)){ @{$hhh{$lett}{$num}{$tes}{$users}}=qw(beer vodka); } } } } print "hash\tsubhash\t subsubhash\tmassives\n"; for $let(sort keys %hhh) { print "hash $let: (\n"; for $nums (sort keys %{$hhh{$let}}) { print "\tsubhash $nums (\n\t"; for $ltr(sort keys %{$hhh{$let}{$nums}}){ print "\tsubsubhash $ltr (\n\t"; for $aa(sort keys %{$hhh{$let}{$nums}{$ltr}}){ print "\t\t'$aa' => [ "; print join " | " => @{$hhh{$let}{$nums}{$ltr}{$aa}}; print " ]\n\t"; } print ")\n\t"; } print " \t)\n"; } print ")\n"; } ** Joe's Own Editor v2.8l ** Copyright (C) 1995 Joseph H. Allen ** File hhhsh.pl not changed so no update needed. bash-2.05$ ./hhhsh.pl | less hash subhash subsubhash massives hash beer: ( subhash peace ( subsubhash one ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) subsubhash two ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) ) subhash war ( subsubhash one ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) subsubhash two ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) ) ) hash meat: ( subhash peace ( subsubhash one ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) subsubhash two ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) ) subhash war ( subsubhash one ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) subsubhash two ( 'bred' => [ beer | vodka ] 'pitt' => [ beer | vodka ] ) ) ) bash-2.05$
Хеши можно строить любой степени вложенности просто прибавляя лишний цикл и лишнюю пару фигурных скобок в $hhh{$lett}{$num}{$tes}{$users}, т.е. $hhh{$lett}{$num}{$tes}{$users}{$dream} уже будет хешем хешей хешей хешей хешей т.д.
А в конце, используя оператор @{а тут хеш хешей хешей хешей хешей ... n+1 ...}=qw(blah blah blah) можно приспособить хешn массивов. Итого это будет выглядеть так:
@{$hhh{$lett}{$num}{$tes}{$users}}=qw(beer vodka);
Соответственно дает быстрый доступ к катологизированной информации.
Осталось сделать хеш любой степени вложенности для, например, хранения дерева каталогов и, скажем, базы пермишнов на файлы, если вдруг нечаянно ввел не ту команду.
#!/usr/bin/perl -w use strict; my @table; my $i; my $j; for $i (0..10) { for $j (0..10) { $table[$i][$j] = $i * $j; } } #вывести: for ($i = 0; $i < @table; $i++){ for($j =0; $j < @{$table[$i]}; $j++){ print "$i : $j : ", $table[$i][$j], "\n"; } } #можно и так: for $i (0..$#table) { for $j (0..$#{$table[$i]}) { print "$i : $j : " . $table[$i][$j] . "\n"; } }
Необходимо ввести регистрацию с таким паролем, чтобы было не меньше 4-х
букв и цифр и все вперемешку. Программа такая:
#!/usr/bin/perl -w
use strict;
my @attempts = qw(a1s2d3f4 1234abcd 123abcdef no123good t78903h
t78903hg t78903hgf t78j903hgf);
foreach my $attempt (@attempts)
{
if ($attempt =~/^(?=(?:\D*\d){4})(?=(?:[^a-zA-Z]*[a-zA-Z]){4})[^\W_]+$/)
{
print "$attempt matched\n";
}
}
программа напечатает:
a1s2d3f4 matched
1234abcd matched
t78903hgf matched
t78j903hgf matched
Соответственно регулярное выражение работает примерно так:
(?=(?:\D*\d){4}) обеспечивает нахождение не менее 4-х цифр, используя заглядывание вперед.
(?=(?:[^a-zA-Z]*[a-zA-Z]){4}) обеспечивает нахождение 4-х букв.
^ и [^\W_]+$ находит только бквы и цифры. Специальные значки, например +, рассматриваться не будут. Можно ввести ограничение по длинне, например {8,16}. Регулярное выражение возвращает либо истину, либо ложь, соответственно на этом условии и работает программа.