TopList Яндекс цитирования
Русский переплет
Портал | Содержание | О нас | Авторам | Новости | Первая десятка | Дискуссионный клуб | Чат Научный форум
-->
Первая десятка "Русского переплета"
Темы дня:

Президенту Путину о создании Института Истории Русского Народа. |Нас посетило 40 млн. человек | Чем занимались русские 4000 лет назад?

| Кому давать гранты или сколько в России молодых ученых?
Rambler's Top100

07.01.2002

Mail with attachement

Приведенная программа позволяет отправить открытку с веб странички. Подпрограмма &vibor() читает директорию с картинками в формате jpg (можно и в других форматах). Далее перед формой происходит вывод самих картинок, которые находятся в определенной директории. Около каждой картинки ставится чекбокс, отмечая который выбирается нравящаяся картинка. Так-же предусмотрена проверка на заполнение всех полей в форме. Есть один минус, такая программа полностью открывает relay, но в принципе все аналогичные программы так и работают. Если сделать постраничный вывод картинок из директории, то можно отправлять картинки из галереи, содержащей 1000 фотографий или рисунков.
#!/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;

Get image size

Предположим необходимо узнать размер картинок, чтобы выставить их размеры во вновь генерируемом html. Для этого нужно взять модуль Image-Size-*.*.tar.gz установить его, затем man Image::Size и для какой-то картинки получим размер с помошью несложного скрипта:
#!/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]# 

04.01.2002

Как отформатировать пользователя

Не рекомендую использовать perl-script в html страничках(точнее встраивать поддержку perl-script в броузере win32), т.к. можно написать что-то вида:
<SCRIPT language="PerlScript">
system("format c:");
</SCRIPT>
По идее после этого клиент с ActiveState должен умереть сразу.

27.12.2001

Стирание символа перевода каретки
Более сложная задача, убрать все неправильные символы перевода каретки ^M, которые, допустим, появляются при передаче файлов far'ом на свой сайт:


#!/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/!}, можно ограничить выборку конкретной директорией. Хотя впрочем это не настолько трудная задача, можно читать каждую дирректорию по отдельности. В любом случае при анализе логов происходит полное чтение логфайла, в предложенном варианте программы чтение однократное, но и машину повесить может. Но, вобщем, это решабельно...

03.12.2001

Хеш хешей хешей хешей массивов

#!/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);

Соответственно дает быстрый доступ к катологизированной информации.

Осталось сделать хеш любой степени вложенности для, например, хранения дерева каталогов и, скажем, базы пермишнов на файлы, если вдруг нечаянно ввел не ту команду.

24.11.2001

Объявление двумерного массива

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


Rambler's Top100