Интернет технологии -> Perl -> Программирование на PERL

Исследование Perl модулей, часть 1. Создание графики на лету с использованием GD

Pradeep Padala, перевод - Алексей Чегляков ( providerZ.ru )

Добро пожаловать!

Несмотря на то, что модули являются одной из составляющих успеха Perl, существующая документация и литература посвящена преимущественно широко распространенным модулям (например CGI, DBI, и т.п.), а пользователи менее популярных оставлены один на один с похожей на шифрограммы и порою незаконченной документацией.

Я начинаю серию статей, в которой попытаюсь познакомить вас с не самыми популярными, но достаточно полезными модулями, с которыми мне довелось поработать за последние несколько. Я постараюсь использовать этот опыт и буду пояснять принципы работы на примерах. Мы будет брать какой-то один модуль и рассматривать различные способы его использования.

Для кого это предназначено

Вы должны уметь программировать на Perl. Мы не будем объяснять какие-то основополагающие вещи. В настоящий момент существует уже довольно много литературы и статей на эту тему. Например книга Learning Perl (по-моему есть русское издание. А.Ч) окажется весьма полезной для начинающих, а те, кто уже знает основы, могут почитать Programming Perl.

Если вы не очень опытный программист, и еще не использовали модули в своей работе, то эта информация может оказаться весьма полезной. Модули позволяют многократно использовать единожды реализованный код и создавать эффективные и компактные приложения. В каждой статье мы будем идти от простого к сложному и заканчивать примерами, которые вполне могут быть использованы в реальных приложениях.

Введение в модули

    use module;

    use GD;

Поиск и установка модулей

Прежде чем мы займемся подробностями программирования с использованием модулей, я немного коснусь вопросов, касающихся их поиска и установки. Многие из них могут быть не установлены в системе по умолчанию. Кроме того, некоторые модули могут требовать наличия библиотек, которые так же по умолчанию не установлены. Ниже приведены краткие инструкции. (Мы уже писали на эту тему в отдельном материале. А.Ч.)

Самый простой способ установки нового модуля, это использование возможностей, предоставляемых модулем CPAN. Запустите CPAN в интерактивном режиме.

    perl -MCPAN -e shell

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

    install GD

Или же можно сделать все вручную:

• Найти необходимый модуль на CPAN'е (например в полном списке)
• Скачать требуемое. В нашем случае последнюю версию GD можно забрать по адресу http://www.cpan.org/authors/id/LDS/GD-1.40.tar.gz
• Распаковать архив

      tar zxvf GD-1.40.tar.gz
  

• Собрать модуль

      perl Makefile.PL 
          (or)
      perl Makefile.PL PREFIX=/my/perl/directory 
          (if you want to install in /my/perl/directory)
      make
      make test (optional)
  

• И установить

      make install
  
  

Можно начинать ...

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

Графика с использованием GD

Начнем с простого и наглядного примера

#!/usr/local/bin/perl -w

# При необходимость измените путь к интерпретатору perl

use GD;

# Создаем новое изображение
$im = new GD::Image(100,100);


# Определяем цвета
$white = $im->colorAllocate(255,255,255);
$black = $im->colorAllocate(0,0,0);

$red = $im->colorAllocate(255,0,0);
$blue = $im->colorAllocate(0,0,255);


# Делаем бэкграунд прозрачным и interlaced
$im->transparent($white);
$im->interlaced('true');

# Рисуем черную рамку
$im->rectangle(0,0,99,99,$black);


# Рисуем синий овал
$im->arc(50,50,95,75,0,360,$blue);


# И заливаем его красным цветом
$im->fill(50,50,$red);

# Открываем файл на запись 
open(PICTURE, ">picture.png") or die("Cannot open file for writing");


# Не забудьте включить бинарный режим 
binmode PICTURE;

# Конвертируем изображение в PNG формат и выводим его в файл
print PICTURE $im->png;
close PICTURE;

Это немного измененный пример из руководства по GD. Программа рисует небольшой прямоугольник с красным овалом с синей каймой внутри. Рассмотрим ее.

В начале идет создание дескриптора изображения, с которым мы будем работать в дальнейшем. Строка

    $im = new GD::Image($width, $height)

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

Теперь мы должны определить цвета. Как вы догадались, для этого испольуется RGB. Поскольку далее нам придется делать это неоднократно, имеет смысл сразу написать небольшую функцию.

# Сохраните в файле init_colors.pl

# Другие наши скрипты будут вызывать эту функцию

sub InitColors {
    my($im) = $_[0];
    # Определение цветов

    $white = $im->colorAllocate(255,255,255);
    $black = $im->colorAllocate(0,0,0);
    $red = $im->colorAllocate(255,0,0);
    $blue = $im->colorAllocate(0,0,255);
    $green = $im->colorAllocate(0, 255, 0);

    $brown = $im->colorAllocate(255, 0x99, 0);
    $violet = $im->colorAllocate(255, 0, 255);
    $yellow = $im->colorAllocate(255, 255, 0);
}

Эта страница может оказаться полезной при определении rgb-комбинаций цветов.

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

    binmode MYFILEHANDLE;

В принципе, это неактуально в большинстве юникс-систем.

Затем мы просто выводим имеющееся изображение в файл. GD может делать вывод в разных форматах. Например, если бы вы захотели получить не png а jpg, то строка вывода выглядела бы так:

    print MYFILEHANDLE $im->jpeg;

Простой рисунок

При создании изображений с использованием GD могут испольуются примитивы.

#!/usr/local/bin/perl
# При необходимость измените путь к интерпретатору perl

use GD;
do "init_colors.pl";


# Создаем изображение
$im = new GD::Image(640,400);

# Назначаем цвета
&InitColors($im);


# Делаем основание прозрачным и interlaced
$im->transparent($white);
$im->interlaced('true');

$x1 = 10;

$y1 = 10;
$x2 = 200;
$y2 = 200;

# Рисуем рамку

$im->rectangle(0, 0, 639, 399, $black);
# Линию
$im->line($x1,$y1,$x2,$y2,$red);

# Штриховую линию
$im->dashedLine($x1 + 100, $y1, $x2, $y2, $blue);

# Прямоугольник
$im->rectangle($x1 + 200, $y1, $x2 + 200, $y2, $green);

# Прямоугольник с заливкой
$im->filledRectangle($x1 + 400, $y1, $x2 + 400, $y2, $brown);

# Круг
$im->arc($x1 + 100, $y1 + 200 + 100, 50, 50, 0, 360, $violet);


# Работа с многоугольником
# Создаем многоугольник
$poly = new GD::Polygon;
$poly->addPt($x1 + 200, $y1 + 200);

$poly->addPt($x1 + 250, $y1 + 230);
$poly->addPt($x1 + 300, $y1 + 310);

$poly->addPt($x1 + 400, $y1 + 300);
# Отрисовываем его на наше изображение
$im->polygon($poly, $yellow);


# Открываем файл на запись 
open(PICTURE, ">picture.png") or die("Cannot open file for writing");

# Включаем двоичный режим
binmode PICTURE;


# Преобразуем картинку в PNG и выводим в файл
print PICTURE $im->png;
close PICTURE;

В результате должно получиться что-то наподобие этого.

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

Отображение текста

А как насчет текста? Для отображения текста вы можете воспользоваться простыми шрифтами поставляемыми с GD, либо использовать True Type если он имеется в вашей системе. Вот две простых функции, которые можно использовать при отображении текста:

    # Изобразить текст
    $im->string($font, $x, $y, $string, $color);

    # Изобразить текст, повернутый на 90 градусов
    $im->stringUp($font, $x, $y, $string, $color);

#!/usr/local/bin/perl
# При необходимость измените путь к интерпретатору perl

use GD;
do "init_colors.pl";

# Создаем изображение
$im = new GD::Image(200, 80);


# Назначаем цвета
&InitColors($im);

# Делаем фон прозрачным и interlaced
$im->transparent($white);
$im->interlaced('true');


# Рисуем рамку
$im->rectangle(0, 0, 199, 79, $black);
$x1 = 2;

$y1 = 2;

# Рисуем текст шрифтом разного размера
$im->string(gdSmallFont, $x1, $y1, "Small font", $blue);

$im->string(gdMediumBoldFont, $x1, $y1 + 20, "Medium Bold Font", $green);
$im->string(gdLargeFont, $x1, $y1 + 40, "Large font", $red);

$im->string(gdGiantFont, $x1, $y1 + 60, "Giant font", $black);

# Открываем файл на запись 
open(PICTURE, ">picture.png") or die("Cannot open file for writing");


# Включаем двоичный режим
binmode PICTURE;

# Преобразуем изображение в PNG и выводим в файл
print PICTURE $im->png;
close PICTURE;

Результат выглядит следующим образом:

Как видите, из-за шрифтов текст выглядит не лучшим образом. Попробуем использовать True Type.

Шрифты True Type

Вы можете использовать шрифты true type, наверняка имеющиеся в вашей системе.Для этого используется функция stringFT.

    # в переменной $fontname должен содержаться полный путь до используемого TrueType шрифта.
    stringFT($fgcolor,$fgcolor,$fontname,$ptsize,$angle,$x,$y,$string);

Пример использования

#!/usr/local/bin/perl
# При необходимость измените путь к интерпретатору perl

use GD;
do "init_colors.pl";

# Создаем изображение

$im = new GD::Image(270, 80);

# Назначаем цвета
&InitColors($im);

# Делаем фон прозрачным и interlaced

$im->transparent($white);
$im->interlaced('true');

$im->rectangle(0, 0, 269, 79, $black);


$x1 = 10;
$y1 = 20;

# Рисуем текст TTF шрифтом
$font = "/usr/X11R6/lib/X11/fonts/TTF/luxisri.ttf";

$im->stringFT($red, $font, 15, 0, $x1, $y1, "A TTF font");


$anotherfont = "/usr/share/fonts/default/TrueType/starbats.ttf";
$im->stringFT($blue, $font, 20, 0, $x1, $y1 + 40, "Another one here !!!");


# Открываем файл на запись 
open(PICTURE, ">picture.png") or die("Cannot open file for writing");

# Включаем двоичный режим
binmode PICTURE;


# Конвертируем изображение в PNG и выводим в файл
print PICTURE $im->png;
close PICTURE;

Результат выглядит следующим образом.

Выходим в онлайн

Ну вот, кое-что делать мы уже научились. Теперь давайте свернем поближе к вебу. Можем ли мы на лету вывести изображение через CGI? Запросто. Добавьте эти строки в программу вместо ранее используемого вывода в файл.

    # Выключение буферизации, необходимое для нормального вывода изображения.
    select(STDOUT);
    $  = 1;
    undef $/;

    print "Content-type: image/jpeg\n\n";
    print $im->jpeg(100);

Пока что это все, что нам нужно знать про CGI. Если вы знакомы с CGI, то можете поиграться со скриптом и усложнить его в требуемой степени. А мы пока напишем небольшую программу, которая будет читать с диска изображение и выводить на экран его масштабированную версию. Это может пригодиться при создании иконок предварительного просмотра.

#!/usr/local/bin/perl -wT

# При необходимость измените путь к интерпретатору perl

use CGI ':standard';
use GD;

# создаем изображение
$image_file = "images/surfing.jpg";

$im = GD::Image->newFromJpeg($image_file);
($width, $height) = $im->getBounds();
$newwidth = $width / 3;

$newheight = $height / 3;
$outim = new GD::Image($newwidth, $newheight);


# делаем фон прозрачным и interlaced
$outim->copyResized($im, 0, 0, 0, 0, $newwidth, $newheight, $width, $height);


# включаем двоичный режим вывода
binmode STDOUT;
select(STDOUT);
$  = 1;
undef $/;

print "Content-type: image/jpeg\n\n";
print $outim->jpeg();

В этом примере функция newFromJpeg() читает jpeg файл, а затем масштабирует его соответственно заданным границам. Пример работы этой программы можно увидеть тут

Фотоальбом

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

#!/usr/local/bin/perl -wT
# При необходимость измените путь к интерпретатору perl

use CGI ':standard';
use GD;

$imnum = param('imnum');

if(!defined($imnum)) {
    $imnum = 0;
}

$orig = param('orig');

if(!defined($imnum)) {
    $orig = 0;
}

select(STDOUT);
$  = 1;


@images = ("surfing.jpg", "boat.jpg", "boston-view.jpg", "seashore.jpg");

print "Content-type: text/html\n\n";
print "<font color=green>Нажмите на картинку для увеличения или уменьшения<br>

Нажмите на кнопку или номер для смены картинки</font>\n";
print "<table><tr>\n";

if($imnum > 0 && $imnum < @images) {
    printf "<td><a href=album.cgi?imnum=%d><img src=images/prev.gif border=0></a>\n", $imnum-1;
}


if($imnum >= 0 && $imnum < @images - 1) {
    printf "<td><a href=album.cgi?imnum=%d><img src=images/next.gif border=0></a>\n", $imnum+1;
}


print "<td>";
for($i = 0; $i < @images; ++$i) {
    print "<a href=album.cgi?imnum=$i>$i </a>\n";
}

print "</tr></table>\n";
if($imnum < 0    $imnum >= @images) {
    print "<b>Нет такой картинки</b>";
    exit;
}


if($orig) {
    print "<a href=album.cgi?imnum=$imnum><img src=images/$images[$imnum] border=0></img></a>\n";
}

else {
    $im = GD::Image->newFromJpeg("images/$images[$imnum]");
    # create a new image
    ($width, $height) = $im->getBounds();
    $newwidth = 200;
    $newheight = 200;
    $outim = new GD::Image($newwidth, $newheight);

    $outim->copyResized($im, 0, 0, 0, 0, $newwidth, $newheight, $width, $height);
    $tmpfile = "images/tmp$imnum.jpg";
    if ($tmpfile =~ /^([-\@\w.\/]+)$/) {   # For the tainting stuff

        $tmpfile = $1;
    }
    else {
        print "Не должно такого быть";
        exit; # Не должно такого быть

    }
    open(TMP, ">$tmpfile")    die("Cannot open file");
    binmode(TMP);
    print TMP $outim->jpeg(100);
    close(TMP);
    chmod(0644, $tmpfile);
    print "<a href=album.cgi?imnum=$imnum&orig=1><img src=$tmpfile border=0></a>";
}

Этот скрипт использует некоторые особенности CGI. Функция param возвращает значение передаваемого параметра если оно задано. Это значение используется для выбора той или иной картинки. Если пользователь хочет посмотреть оригинал, он отображается. В противном случае отображается уменьшенная копия.

Демонстрацию работы программы можно посмотреть тут.

Графический счетчик

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

При каждом посещении страницы cgi скрипт должен засчитать посетителя и сгенерировать картинку на лету. Ждать нечего, давайте это сделаем.

#!/usr/local/bin/perl -wT
use GD;
use strict;

my($LOCK_SH, $LOCK_EX, $LOCK_NB, $LOCK_UN);


$LOCK_SH = 1;
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;


select(STDOUT);
$  = 1;

&main;

sub main {
    my($id, $iformat, $show);

    $id = param("id");
    $iformat = param("iformat");

    my($counter_value);
    $counter_value = &update_counter_value($id);

    chomp($counter_value);
    if($iformat eq "jpg"    $iformat eq "png") {
        &print_counter($iformat, $counter_value);
    }
    else {
        &print_error_image("Графический формат $iformat не поддерживается");
    }
}


sub print_counter {
    my($iformat, $counter_value) = @_;
    my($COUNTER_SIZE) = 4;

    my($im) = GD::Image->new("${iformat}s/0.${iformat}");
    if(!defined($im)) {
        &print_error_image("\$im не может быть инициализировано");
        exit;
    }

    my($w, $h) = $im->getBounds();
    undef $im;

    my($printim) = GD::Image->new($w * $COUNTER_SIZE, $h);
    $printim->colorAllocate(255, 255, 255);

    my($pos, $l, $temp, $digit, $x, $srcim);
    $x = 0;
    for($pos = $COUNTER_SIZE - 1; $pos >= 0; $pos--) {
        if($pos > length($counter_value) - 1) {
            $digit = 0;
        }
        else {
            $l = length($counter_value);
            $temp = $l - $pos - 1;
            $digit = substr($counter_value, $temp, 1);
        }
        $srcim = GD::Image->new("${iformat}s/${digit}.${iformat}");
        $printim->copy($srcim, $x, 0, 0, 0, $w, $h);
        $x += $w;
        undef $srcim;
    }
    if($iformat eq "jpg") {
        print "Content-type: image/jpeg\n\n";
        print $printim->jpeg(100);
    }
    else {
        print "Content-type: image/png\n\n";
        print $printim->png;
    }
}


sub print_error_image {

    my $error_string = $_[0];
    my $im = new GD::Image(
    gdMediumBoldFont->width * length($error_string),
    gdMediumBoldFont->height);

    $im->colorAllocate(255, 255, 255);
    my $red = $im->colorAllocate(255, 0, 0);
    $im->string(gdMediumBoldFont, 0, 0, $error_string, $red);
    print "Content-type: image/jpeg\n\n";
    print $im->jpeg(100);
    exit;
}


sub update_counter_value {
    my($file_name, $counter_value);

    $file_name = "$_[0].counter";
    if ($file_name =~ /^([-\@\w.]+)$/) {   # For the tainting stuff

        $file_name = $1;
    }
    else {
        exit; # Не должно такого быть
    }
    if(open(COUNTERFILE, "+<$file_name") == 0) {
        # Если файла нет, создаем его и открываем

        open(COUNTERFILE, ">$file_name");
        print COUNTERFILE "1";
        close(COUNTERFILE);
        return 1;
    }

    flock(COUNTERFILE, $LOCK_EX);
    $counter_value = <COUNTERFILE>;
    seek(COUNTERFILE, 0, 0);
    ++$counter_value;
    print COUNTERFILE $counter_value;
    flock(COUNTERFILE, $LOCK_UN);

    close(COUNTERFILE);
    return($counter_value - 1);
}

Для вызова этого скрипта необходимо включив в HTML-страницу следующий код:

    <img src=counter.cgi?id=my_html_file.html&iformat=jpg>

Идентификатор файла счетчика должен быть уникальным. Пример работы можно увидеть на моей странице.

Разберем скрипт. Есть три основных момента

update_counter_value: 	Эта функция читает значение счетчика из
				файла html_file.counter и увеличивает его. Она же
				создает этот файл в случае если его не было.
				Для предотвращения ошибок в подсчетах при
				одновременном доступе на время работы файл блокируется.

print_counter:	        Выводит счетчик, накладывая цифры на картинку. Файлы
				с картинками лежат в соответствующей директории.

print_error_image:    	Используется для вывода сообщений об ошибках.
				

Требующиеся изображения цифр вы можете взять например на сайте Counter Art dot Com. В следующей статье мы поговорим о том, как рисовать цифры на лету.

На основе изложенной концепции я разработал пакет personal website statistics. Этот пакет сохраняет информацио о показах, посетителях, и многое другое. Познакомьтес с ним

Так же для управления файлом счетчика вы можете использовать модуль File::CounterFile.

Далее...

Надеюсь, что статья вам понравилась. В дальнейшем мы рассмотрим использование модулей GD::Graph и PerlMagic. Вы можете отправить мне отзыв на этот адрес.

Have Fun !!!

Благодарности

Мой лучший друг ravi является моим официальным редактором. Я ему весьма обязан за вычитку всей этой писанины. ravi, спасибо! :-) Спасибо так же Бенджамину Окопнику (Benjamin A. Okopnik) за вычитку статьи и советы.

Оригинал статьи размещен в LinuxGazette