#!/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}. Регулярное выражение возвращает либо истину, либо ложь, соответственно на этом условии и работает программа.