http://www.nadomnik.by.ru/


Hello, Perl! Perl FAQ по-русски. Часть 6

Дмитрий Репин aka cmapuk[0nline]

Этой частью мы начнём вторую половину этого опуса, посвящённую практическому программированию на Perl.

Чистая практика. Ну вот и добрались

В этом разделе я не буду придерживаться какой-то определенной тематики, просто приведу примеры, которые, как мне кажется, должны стать ответами на ЧастоЗадаваемые в форумах по Perl вопросы. Кроме примеров скриптов я расскажу о том, какие модули Perl, сервисы или технологии могут вам понадобиться для выполнения различных задач.

Начнем с простой, но в то же время вызывающей трудности программы - генератора картинок на примере баннера и счетчика посещений.

Создавать изображения можно вручную, изучив спецификацию GIF или JPEG. Это требует особого уровня знаний и навыков программирования. Начинающим программистам целесообразнее будет воспользоваться готовыми модулями - GD, Image-Magick, и т.п. Это не стандартные модули, поэтому надо снова зайти на CPAN. Рассмотрим рисование с помощью GD.

#!/usr/bin/perl
use GD;
# Создаем объект картинки-баннера 468x60
$image = new GD::Image(468,60);
# Определяем цвета в RGB- палитре (каждый цвет по яркости от 0 до 255)
$white = $image->colorAllocate(255,255,255); # (красн.,зел.,син.)
$black = $image->colorAllocate(0,0,0);
$red = $image->colorAllocate(255,0,0);
$blue = $image->colorAllocate(0,0,255);
$green = $image->colorAllocate(0,255,0);
$darkblue = $image->colorAllocate(0,0,80);
$darkgreen = $image->colorAllocate(0,80,0);
# Выбираем цвет, который будет прозрачным
$image->transparent($white);
# Interlaced свойство true/false = да/нет
$image->interlaced('true');
# Рисуем незалитый прямоугольник темно-синим цветом
$image->rectangle(0,0,467,59,$darkblue);
# И заполняем его красным цветом
$image->fill(1,1,$red);
# Рисуем незалитый прямоугольник зеленым цветом
$image->rectangle(5,5,300,40,$green);
# И заполняем его темно-зеленым цветом
$image->fill(7,7,$darkgreen);
# Пишем строку простым текстом
$image->string(gdMediumBoldFont,10,10,"Hello, Perl!",$white);
# Пишем строку TrueType шрифтом
$image->stringTTF($white,"C:\\WINNT\\-Fonts\\arialb-d.ttf",16,0,120,30,"Hello again!");
# Параметры: цвет, путь к ttf-файлу, размер(pt),
# угол поворота(рад), позиция x,y и сама строка.
# Теперь определим еще одну картинку, которая будет кистью 5х5
$brush = new GD::Image(5,5);
$white_b = $brush->colorAllocate(255,255,255);
$black_n = $brush->colorAllocate(0,0,0);
$brush->transparent($white_b);
# Кисть из диагональной линии
$brush->line(0,0,5,5,$black);
# Определим кисть для нашей картинки
$image->setBrush($brush);
# Нарисуем круг с координатами 370,30
# Размер по x,y = 50x50
# Дуга от 0 до 360, то есть полный круг
$image->arc(370,30,50,50,0,360,gdBrushed);
# Устанавливаем двоичный режим вывода
binmode STDOUT;
# Выводим картинку в броузер в PNG-формате (почти аналог GIF)
print "Content-type:image/png\n\n";
print $image->png;

Осталось только добавить в этот код счетчик показов баннера.

Это был пример самостоятельного рисования, но не обязательно каждый раз полностью создавать картинку. Есть способ лучше. Нарисуем картинку счетчика в каком-нибудь "фотошопе" и сохраним ее рядом со скриптом как counter.png (формат PNG!!!).

use GD;
# Создаем объект картинки из файла
$image = newFromPng GD::Image("counter.png");
# Определяем цвета в RGB- палитре
$white = $image->colorAllocate(255,255,255);
$darkblue = $image->colorAllocate(0,0,80);
# Выбираем цвет, который будет прозрачным
$image->transparent($white);
# Interlaced свойство true/false = да/нет
$image->interlaced('true');
# ...
# Здесь мы подсчитаем посетителей и
# положим в $num - количество оных
$num="1000";
# ...
# Пишем строку TrueType шрифтом Arial bold, темно-синим цветом
$image->stringTTF($darkblue,"C:\\WINNT\\-Fonts\\-arialbd.ttf",14,0,3,70,$num." uniq");
# Устанавливаем двоичный режим вывода
binmode STDOUT;
# Выводим картинку в броузер
print "Content-type:image/png\n\n";
print $image->png;

Модуль GD позволяет читать/сохранять изображения, рисовать, манипулировать кистями, цветами, текстом и т.д. Полное описание модуля, конечно же, в perldoc GD.

GD имеет и подмодули. Например, GD::Graph предоставляет возможность рисовать всевозможные графики, GD::Graph3d - трехмерные графики, GD::Text - работа с текстом.

Работа с почтой в скриптах. Отправлять письма можно с помощью внешних программ (таких, как Sendmail), а также с помощью модулей Perl. Можно также, изучив спецификацию протокола SMTP, писать мэйлер самим, но этот вариант выходит за рамки FAQ.

Итак, способ первый.

open(M, "|/path/to/sendmail -t"); # Открываем программу на запуск с передачей ей параметров
print M " From:cmapuk[0nline] дома \n"; # Пишем заголовки (как в CGI)
print M " To:cmapuk[0nline] на работе \n";
print M " Subject: Не пора ли домой?\n\n"; # После "Темы" нужно сделать пустую строку (\n\n)
print M " Время уже позднее. Пора ехать домой."; # Текст письма
close(M); # Закрываем программу;

Вот так можно отправить письмо из скрипта с помощью Sendmail. Надеюсь, смысл полей "From", "To", "Subject" Вам ясен ;-).

Способ второй.

use Mail::Mailer;
$mail = Mail::Mailer->new();
$mail->open({ From => $addr_from,
                 To => $addr_to,
                 Subject => $subj
                 });
print $mail $bodytext;
$mail->close();

Вообще, модули семейства Mail::*** предоставляют большие возможности для работы с электронной почтой.

Mail::Address - Разбор адресов (Вася Пупкин )
Mail::IMAPClient - Чтение почты с сервера IMAP
Mail::POP3Client - Чтение почты с сервера POP3
Mail::Sendmail - А-ля Sendmail
Mail::Util - Различные утилиты

Для отправки писем с вложенными файлами воспользуйтесь модулем MIME::Entity

use MIME::Entity;
$mail = MIME::Entity->build(
  To => $addr_to,
  Subject => $subj,
  Data => $body,
  Charset => $charset # "win-1251", # "koi8-r", etc
  );
$mail->attach(
  Path => "/path/to/file",
  Type => $mime_type, # "image/gif", "image/jpeg", и т.п.
  Encoding => "base64",
  Disposition=>"attachment",
  );
open(MAIL, "|/path/to/sendmail -t");
$mail->print(\*MAIL);
close(MAIL);

Кстати, список MIME-типов можно посмотреть, если установлен Apache, в файле /путь/к/апачу/conf/mime.types.

Вообще, модуль MIME с расширениями - весьма полезная штука. Он поможет и с различными отправками писем (с аттачами, в виде HTML, и т.д.), с кодированиями/раскодированиями Base64, QuotedPrint, и т.п.

Если вы уже знаете протокол SMTP, то можно воспользоваться модулем Net::SMTP, который позволяет общаться с сервером на более низком уровне. Так вы сможете обрабатывать ответы сервера.

Загрузка/Разгрузка файлов по через Web. Основные вопросы в этой области - "Как закачать файл на сервер?" и "Как сделать счетчик скачивания?". Вот и разберемся.

Закачка файлов.

#!/path/to/perl
# Определим путь директории для сохранения данных
$path="/home/users/vasya/data";
# Отправляем юзера на форму закачки,
# если он вызвал скрипт в строке броузера или
# пришел по линку (см. print_form ниже)
&print_form("") if $ENV{REQUEST_METHOD} eq "GET";
# Читаем все данные в переменную $buff
binmode STDIN;
read(STDIN,$buff,$ENV{CONTENT_-LENGTH});
# Отправим на форму, если тип не multipart/form-data
&print_form("Неправильный тип данных") if $ENV{CONTENT_TYPE} !~/multipart\/form\-data/;
# Выборка из Content-type разделителя для данных
($div = $ENV{CONTENT_TYPE}) =~ s/^.*boundary=(.*)$/$1/;
# Делим данные в массив
@blocks = split/$div/, $buff;
# Обрезаем крайние элементы - они будут пустыми
@blocks = splice(@blocks,1,$#blocks-1);
# Читаем по порядку элементы массива в $_
# и обрабатываем
for(@blocks){
         # Делим на заголовок и данные
         ($header,$data)=split/\n\n/,$_;
         # Делим заголовок на подзаголовки
         # Content-Deposition и Content-type
         ($deposit,$type)=split/\n/,$header;
         # Получим в $type чистое значение
         # Типа gif, jpeg, zip, plain, и т.п.
         $type=~s/^Content-type: ([a-z])\/(.+)$/$2/;
         # Тип plain - это текст, то есть либо текстовый
         # файл, либо значение простого поля формы
         # Выбираем из Deposition имя поля формы и имя файла
         ($name=$deposit)=~s/ name="(.+)"/$1/;
         ($file=$deposit)=~s/ filename="(.+)"/$1/;
  $file=~s/\\/\//; # Заменим "X:\file.gif" на "X:/file.gif"
  ($file)=reverse split/\//,$file; # Выборка чистого имени "file.gif"
  if($file){
         # Если в $file не пусто, пишем файл
         open(F,">$path/$file");
         binmode(F);
         print F $data;
         close(F);
  }else{
         # Иначе данные - текст поля формы
         # Дописываем в файл для текстов
         open(F,">>$path/mytexts");
         # Пишем с разделителем
         print F "$data\n------------------------";
  close(F);
  }
}
# Пишем "Спасибо юзеру"
print "Content-type:text/html\n\n
<html>
<body>
<h1>Спасибо</h1>
</body></html>";
# Завершаемся
exit;

sub print_form{
my $message=shift; # Здесь мы принимаем текст
                 # какого-либо сообщения юзеру
print "Content-type:text/html

<html>
<head><title>Uploader</title></head>
<body>
<h1>Upload</h1>
<h3>$message</h3>
<form method=POST action=\"upload.cgi\" enctype=\"multipart/form-data\">
<input type=file name=file1><br>
<input type=file name=file2><br>
<input type=file name=file3><br>
<textarea name=text cols=20 rows=10></textarea><bR>
<input type=submit value=Send>
</form>
</body>
</html>";
exit;
}

Этот пример далек от совершенства и небезопасен. Необходимо проверять полученные данные. Например, для ограничения размера закачиваемых файлов (lenght($data)) или допуска только файлов определенного формата (gif, jpeg, etc). Также нужно проверять данные на недопустимые символы. Думаю, принцип закачки вам ясен, и все эти премудрости вы сможете дописать к скрипту сами.

Теперь о счетчиках скачивания файлов. Здесь все намного проще.

#!/path/to/perl
# Читаем из строки запроса ID файла
# script.cgi?FID
$fid=$ENV{QUERY_STRING}
# Путь к директории с файлами
$path="/home/user/files";
# Для начала нужно определить массив или хэш
# соответствий номера файла его имени.
# Простейший вариант: в текстовом файле
# строки типа "001|referat.zip"
open(F,"files.dat")
while($line=){
         chomp($line);
         ($id,$file)=split/\|/,$line;
         $FILES{$id}=$file;
}
close(F);
# Выдаем сообщение об ошибке, если запрошенный FID не
# соответствует ни одному файлу
if(!exists $FILES{$fid}){
         print "Content-type:text/html\n\n;
         print "Файл не найден";
         exit;
}
# Засчитываем скачивание
open(F,"+ flock(F,2); # Блокируем файл
# Считываем из файла строки типа "ID файла|счет";
while($line=){
         chomp($line);
         ($fileid,$count)=split/\|/,$line;
         $RATE{$fileid}=$count;
}
# Прибавляем к соответствующему ID единицу,
# устанавливаем курсор на начало файла
# Обнуляем его и записываем новый %RATE в отсортированном виде
$RATE{$fid}++;
seek(F,0,0);
truncate(F,0);
for(reverse sort {$RATE{$a} <=> $RATE{$b}} keys %RATE){
         print F "$_|$RATE{$_}\n";
}
close(F);
undef $/;
# Открываем и читаем файл в переменную;
open(F,"$path/$FILES{$fid}")
binmode(F);
$data=;
close(F);
# Выводим в броузер заголовки
print "Content-type:application/octet-stream\n";
print "Content-Disposition:attachment;filename=-$FILES{$fid}\n";
print "Accept-Ranges:bytes";
print "Content-Length:".length($data)."\n";
print "Connection:close\n\n";
# И сам файл (обязательно binmode - двоичный режим)
binmode(STDOUT);
print $data;
exit;

Вот простейший вариант счетчика для скачивания файлов с вашего сайта. В файле files.dat содержатся соответствия ID-файлов их именам в виде

001|referat1.zip
002|rfc2616.zip

В файле count.dat - отсортированные по убыванию счетчики скачивания для каждого файла в виде

002|2345
001|1030

Главное в скриптах-downloder'ах - выводить правильные заголовки и выдавать файл в двоичном режиме.

Защищенные скрипты. Если ваш сайт имеет зону для зарегистрированных пользователей, например для редактирования аккаунта, и ваш сервер поддерживает защиту с помощью htaccess, вы можете возложить всю заботу об авторизации и идентификации пользователя на сервер. В этом случае в директорию со скриптами пользовательской зоны (например, /cgi-bin/member) необходимо положить файл .htaccess со следующим содержанием:

AuthUserFile /Путь/к/файлу/паролей
AuthGroupFile /dev/null
AuthName "Welcome, Member!"
AuthType Basic
<Limit GET POST>
require valid-user
</Limit>

Теперь в своих скриптах вы можете идентифицировать пользователя по переменной окружения REMOTE_USER. Конечно, вход в запароленную таким образом зону не будет выглядеть так красиво, как форма входа на главной странице сайта. Но это позволяет уменьшить объем кода скрипта, а следовательно, - меньше шансов допустить ошибку.

Если ваш пользователь должен идентифицироваться на всем сайте, такой способ не подойдет. Здесь будет лучше применить способ, описанный выше, с ID-сессии (SID).

Источник: "Компьютер Price", http://www.comprice.ru

 


Copyright © "Internet Zone", http://www.izcity.com/, info@izcity.com