Программа выведет: Cow says: moo Cow can bark

Ну, наверное, вам уже стало понятно почему корова может гавкать?! Тут всё довольно просто и прозрачно. А вот диагностировать подобную проблему в сложной системе с кучей используемых модулей и фреймворков довольно сложно. На это можно убить даже не несколько часов, а несколько дней. Так что, рекомендую локализовывать $@ в DESTROY методе ваших классов.

По этой же причине значению, которое вернул eval, вообще нельзя доверять (ты же не контролируешь код всех модулей, которые используешь), и стоит использовать Try::Tiny или что-то подобное.

(с) этот текст - найденная на просторах интернета копипаста

Извлечение пикселей из картинки при помощи ImageMagick и показ картинки в виждете gtk2-perl.

Gtk2-perl позволяет получить доступ к пикселям при помощи функции get_pixels, которая возвращает 16-ти битную строку пикселей длины w*h*3 для RGB изображения. Единственное неудобство в том, что функции для работы с изображениями Gtk2-perl понимают несколько форматов картинок, а ImageMagick позволяет работать с более чем 90 форматами изображений. Функция Gtk2::Gdk::Pixbuf->new_from_data может из строки в 16-тиричном формате выстраивать картинку. Значит для этого надо открыть картинку, прочитать пикселы и затем сформировать и передать в perl соответствующую строку при помощи библиотеки ImageMagick.

Для начала необходимо написать программу на c, после чего уже писать соответствующий XS-модуль. Программа выглядит как-то так:

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
// подключить API ImageMagick

#include <magick/api.h>

int main(int argc,char **argv) {

//Воспользоваться внутренними типами IM
  ExceptionInfo
      exception;
  Image
      *image;
  ImageInfo

      *image_info;
  PixelPacket 
      *pixels;
  ViewInfo 
      *vinfo;

  int i,j,w,h;
// Инициализировать структуру image info и прочитать изображение
  InitializeMagick(*argv);

// установить обработку событий типа ReadError и т.п.
  GetExceptionInfo(&exception);
// сделлать копию структуры image info
  image_info=CloneImageInfo((ImageInfo *) NULL);

// скопировать в структуру имя файла
  (void)strcpy(image_info->filename,"image.gif");
// прочитать картинку, попутно отработав эксепшены &exception 
  image=ReadImage(image_info,&exception);

  if (image == (Image *) NULL) {

// в случае ошибки
    fprintf(stderr, "readFileMagick: %s: %s\n",
    exception.reason,exception.description);

// MagickError(exception.severity,exception.reason,exception.description);

    return -1;
  }
// открыть открыть просмотр кеша пикселей
  vinfo = OpenCacheView(image);

  pixels = GetCacheView(vinfo, 0,0,image->columns,image->rows);

  if(!pixels) {
    fprintf(stderr, "readFileMagick: ошибка чтения кеша пикселей.\n"); 
    return(-1);

  }
  h = image->columns; //ширина по горизонтали (число столбцов картинки)

  w = image->rows;    //высота по вертикали   (число строк картинки)
// вывести значения пикселов по трем каналам
  for (i = 0; i <= w-1; i++) {

    for (j = 0; j <= h-1; j++) {

      printf("%d ",(int)255*pixels[j+h*i].blue/65535);

      printf("%d ",(int)255*pixels[j+h*i].green/65535);

      printf("%d\n",(int)255*pixels[j+h*i].red/65535);

    }
  }
// закрыть и уничтожить все
  CloseCacheView(vinfo);
  DestroyImageInfo(image_info);

  DestroyImage(image);
  return(0);
}

    setenv LD_LIBRARY_PATH /usr/local/lib
    gcc `Magick-config --cflags --cppflags` pixels.c `Magick-config --ldflags --libs`

SV*
pixs (SV * fn, int k)
  INIT:
       unsigned char * lfn;
       STRLEN l;  /* STRLEN is a certain type of int */
       /* ... */
  CODE:
       lfn = SvPV (fn, l); 

В целом, на XS вышеприведенная программа выглядит таким образом:

#include "EXTERN.h"

#include "perl.h"
#include "XSUB.h"
// string.h нужен для функции strcpy
#include <string.h>
// на всякий случай, для матобработкию. если таковая будет, чтобы не писать при компиляции -lm
#include <math.h>
// для ImageMagick
#include <magick/api.h>

#include "ppport.h"
// определить название модуля, необходимого далее для инициализации ImageMagick
#define PackageName "Pixels"
// название модуля и пакетов
MODULE = Pixels		PACKAGE = Pixels		

// отключить прототипы, о(see perldoc perlxs)
PROTOTYPES: DISABLE
// Инициализировать ImageMagick (see perldoc perlxs)
BOOT:
  InitializeMagick(PackageName);

// скаляр (see perldoc perlguts), функции передаются на вход два параметра,
// имя файла и что-то еще. Тип передаваемых параметров определяется только десь
SV*
pixs(SV *fn, int k)

  INIT:
//Воспользоваться внутренними типами IM
        ExceptionInfo
          exception;
        Image
          *image;

        ImageInfo
          *info,
          *image_info;
        PixelPacket
          *pixels;

        ViewInfo
          *vinfo;
// определить двумерные массивы для хранения пикселов
        int **sm,**sym,i,j;

// переменные для имени  файла и возвращаемого значения пикселов
        unsigned char * lfn, * number;
// определение STRLEN находится в файле config.h (perldoc perlguts)
        STRLEN t; 

// определение типа данных для хеша и для массива *только для XSUBs* (perldoc perlguts)
        HV* hash = newHV(); 
        AV* array = newAV();

  CODE:
// присваивание имени, впрочем, это описано в perldoc perlguts
        lfn = SvPV (fn,t);

// установить обработку событий типа ReadError и т.п.
        GetExceptionInfo(&exception);
// сделлать копию структуры image info
        image_info=CloneImageInfo((ImageInfo *) NULL);

// скопировать в структуру имя файла
        strcpy(image_info->filename, lfn);
// прочитать картинку, попутно отработав эксепшены &exception 
        image=ReadImage(image_info,&exception);

// в случае ошибки
        if (image == (Image *) NULL) {     
          fprintf(stderr, "readFileMagick: %s: %s\n",
          exception.reason,exception.description);

        }
// открыть просмотр кеша пикселей
        vinfo = OpenCacheView(image);
        pixels = GetCacheView(vinfo, 0,0,image->columns,image->rows);

        int h=image->columns; //ширина по горизонтали (число столбцов)
        int w=image->rows;    //высота по вертикали   (число строк)

// занести данные о высоте и ширине картинки в массив, который будет
// сопоставлен с ключом хеша arr
        av_push(array, newSVnv(h));
        av_push(array, newSVnv(w));

        int small=w*h*3;
// выделение памяти для строки возвращаемых пикселов, длина строки должна
// быть равна определенной выше small.
        number=malloc(small*sizeof(*number));

// отработка ошибки, если возникнут проблемы с pixels
        if(!pixels) {
          fprintf(stderr, "readFileMagick: unable to get pixel cache.\n");

        }
// выделение памяти для двумерных массивово
        sm = malloc(w * sizeof(*sm));

        for (i=0; i<w; ++i){

          sm[i] = malloc ( h * sizeof(**sm));

        }
        sym = malloc(w * sizeof(*sym));

        for (i=0; i<w; ++i){

          sym[i] = malloc ( h * sizeof(**sym));

        }
// заполнение массива пикселей для дальнейшей обработки
        for (i=0; i<=w-1; i++) {

          for (j=0; j<=h-1; j++) {

            sm[i][j]=(int)255*pixels[j+h*i].blue/65535;

            sym[i][j]=sm[i][j];

          }
        }
// математическая обработка пикселей, алгоритм подробно описан здесь и  здесь немного
        for (i=k; i<=w-1-k; i++){

          for (j=k; j<=h-1-k; j++){

            int summ=0;
            int ii,jj;
            for (ii=-k; ii<=k; ii++){

              for (jj=-k; jj<=k; jj++) summ+=sm[i+ii][j+jj];

            }
            sym[i][j]=(int)summ/((2*k+1)*(2*k+1));

          }
        }
        int count=0;
// заполнение массива пикселей, которые будут возвращаться в perl-программу по ключу хеша uns
        for (i=0; i<=w-1; i++){

          for (j=0; j<=h-1; j++){

            number[count]=(unsigned char)sym[i][j];

            count++;
            number[count]=(unsigned char)sym[i][j];

            count++;
            number[count]=(unsigned char)sym[i][j];

            count++;
          }
//освободить память из под массивов 
          free (sm[i]);

          free (sym[i]);
        }
        free(sm);

        free(sym);
// закрыть и уничтожить все
        CloseCacheView(vinfo);
        DestroyImageInfo(image_info);

        DestroyImage(image);
// добавить в значение хеша массив
        hv_store(hash, "arr",3,(SV*)array, 0);

// добавить в значение хеша строку unsigned char, которая ассоциируется с ключем uns
// четвертым параметром идет выделение памяти для переменной number
        hv_store(hash, "uns",3, newSVpv ((unsigned char*) number, small*sizeof(number[0])), 0);

        free(number);
      RETVAL = newRV_noinc((SV*) hash);

// прагма (?) RETVAL возвращает ссылку на хеш (perldoc perlguts).
  OUTPUT:
      RETVAL

[vilfred@mobile100 xxx]$ h2xs -A -n Pixels
Defaulting to backwards compatibility with perl 5.8.3
If you intend this module to be compatible with earlier perl versions,
please
specify a minimum perl version with the -b option.

Writing Pixels/ppport.h
Writing Pixels/lib/Pixels.pm
Writing Pixels/Pixels.xs
Writing Pixels/Makefile.PL
Writing Pixels/README
Writing Pixels/t/Pixels.t
Writing Pixels/Changes
Writing Pixels/MANIFEST
[vilfred@mobile100 xxx]$

    LIBS              => ['-L/usr/lib -lMagick -L/usr/X11R6/lib -lfreetype -lz \
-L/usr/lib -ltiff -lfreetype -ljpeg -lXext -lSM -lICE -lX11 -lXt \
-lbz2 -lz -lpthread -lm -lpthread'], # e.g., '-lm'

После этого вносятся соответствующие правки в текст Pixels.xs и далее идут команды perl Makefile.PL, make и make test. Т.к. модуль Pixels.pm не установлен (не было команды make install), то необходимо вновь написанный модуль каким-то образом вызвать в perl-скрипте. Nick Ing-Simmons написал библиотеку blib (perldoc blib), которая находит необходимый модуль.

Соответствующий perl-код такой,(с подсвеченным синтаксисом html). Вобщем, что то в этом роде...

samolet | Предыдущая | Извлечение пикселей | to be continued...

]]> https://rulinux.net/message.php?newsid=34857&page=1 https://rulinux.net/message.php?newsid=34857&page=1 Thu, 04 Mar 2010 16:39:00 +0300 samolet | xs | pixels | подсчет объектов Вызов функции, написанной на языке С из программы на языке perl

Допустим, нужно что-то быстро вычислить, а скорости perl не хватает. Для этого в perl существует специальный интерфейс, позволяющий проводить вычисления на языке C. Соответствующие описания находятся в мауналах например perldoc perlxstut или perldoc perlguts. Ниже по тексту несколько примеров как передавать в модули числа и последовательности байтов и получать на выходе различные структуры данных.

Скаляр

Задача: Нужно вычислить сумму чисел до числа передаваемомго функции, т.е. если функции передать число 5, то она должна вернуть число 1+2+3+4+5=15.

Командой h2xs -A -n Perebor создается пакет Perebor с одноименной директорией, в которой находится файл Perebor.xs, в котороый пишется нижеследующий код (этот пример взят с немецкого сайта):

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

MODULE = Perebor                PACKAGE = Perebor

int
sum_numbers(int x)

        CODE:
         {
           int i, sum;
           for(i=1,sum=0;i<=x;i++) {

             sum+=i;
           }
        RETVAL=sum;
         }

        OUTPUT:
        RETVAL

#/usr/bin/perl -w

BEGIN
  {

    push @INC, "./blib/arch", "./blib/lib";
  }

use Perebor;

$x=Perebor::sum_numbers(5);


print "$x\n";

Массив

Для того, чтобы функция возыращала массив или ссылку на массив, надо сделать так:

#include "EXTERN.h"
#include "perl.h"

#include "XSUB.h"

#include "ppport.h"

MODULE = Perebor                PACKAGE = Perebor

SV*
getnum(int l)
  INIT:
        AV* array;

  CODE:
        int n = 1;
        array = newAV();

        while (n < l) {
          av_push(array, newSVnv(n));

          n++;
        }
      RETVAL = newRV_noinc((SV*)array);

  OUTPUT:
      RETVAL

#/usr/bin/perl -w

BEGIN
  {

    push @INC, "./blib/arch", "./blib/lib";
  }
     
use Perebor;
     
$x=Perebor::massiv(11);
     

print join " " => @{$x},"\n";

#include "EXTERN.h"

#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

MODULE = Perebor                PACKAGE = Perebor


SV*
massiv(int l)
  INIT:
        AV* array;

  CODE:
        int n = 1;
        array = newAV();

        while (n < l) {
          av_push(array, newSVnv(n));

          n++;
        }
      RETVAL = newRV_noinc((SV*)array);

  OUTPUT:
      RETVAL

SV*
massiv_square(int l)

  INIT:
        AV* array;
  CODE:
        int n = 1;

        array = newAV();
        while (n < l) {

          av_push(array, newSVnv(n*n));
          n++;

        }
      RETVAL = newRV_noinc((SV*)array);

  OUTPUT:
      RETVAL

#/usr/bin/perl -w
BEGIN
  {

    push @INC, "./blib/arch", "./blib/lib";
  }

use Perebor;

$x=Perebor::massiv(11);


print join " " => @{$x},"\n";

$x=Perebor::massiv_square(11);


print join " " => @{$x},"\n";

Если есть необходимость передать в программу строку чисел, упакованных функцией pack C*, 123 (т.е. числа в 16-тиричном виде), то возникает проблема следующего толка: при обработке символа '\x00' (ноль в 16-тиричном виде), сишнная функция завершит работу, т.к. ноль это конец записи. Для того, чтобы избежать этой проблемы, нужно помимо строки unsigned char передать её длинну, вычисленную функцией perl length:

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

MODULE = Perebor            PACKAGE = Perebor

SV*
getnum(unsigned char *number, int l)

  INIT:
        AV* array;
        int sum;

        double y;
  CODE:
        int n = 0;

        array = newAV();
        while (n < l) {

          sum=number[n++];
          av_push(array, newSVnv(sum*sum));

        }
      RETVAL = newRV_noinc((SV*)array);

  OUTPUT:
      RETVAL

Perl код, вызывающий функцию getnum, выглядит так:

#/usr/bin/perl -w
BEGIN
{

push @INC, "./blib/arch", "./blib/lib";

}

use Perebor;

$txt="\x00\x01\x02\x03\x04\xdd\xcd\xfe";

$x=Perebor::getnum($txt,length $txt);
print join " " => @{$x},"\n";

Предположим, теперь нужно построить и вернуть в си-программу хеш

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

MODULE = Hval            PACKAGE = Hval

SV *

getnum(int k)

  INIT:
  CODE:

        HV* hash = newHV();
        hv_store(hash, "aaa",3, newSViv(k), 1);

        hv_store(hash, "bbb",3, newSVpv("xxx",0), 0);

      RETVAL = newRV( (SV *) hash ); /* bepmsr| qq{kjs m u}x */

  OUTPUT:
  RETVAL

#!/usr/bin/perl -w

use strict;
use warnings;

use ExtUtils::testlib;
use Hval;
use Data::Dumper;

my $hash_ref = Hval::getnum(10);

foreach my $key (keys %$hash_ref) {
  print "$key => $hash_ref->{$key}\n";

}

$hash_ref = Hval::getnum(2);
foreach my $key (keys %$hash_ref) {

  print "$key => $hash_ref->{$key}\n";
}

$hash_ref = Hval::getnum(7);
foreach my $key (keys %$hash_ref) {

  print "$key => $hash_ref->{$key}\n";
}

File rr.pl not changed so no update needed.
[vilfred@mobile100 Hval]$ perl rr.pl
bbb => xxx
aaa => 10
bbb => xxx
aaa => 2
bbb => xxx
aaa => 7
[vilfred@mobile100 Hval]$ 

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

MODULE = Hval            PACKAGE = Hval

SV *
getnum(char *data,int l,int k)

   INIT:
   CODE:
      
     HV* hash = newHV();

     hv_store(hash, "unsigned_char",3, newSVpv ((char*) data, l*sizeof(data[0])), 0);

                
   RETVAL = newRV( (SV *) hash ); 
                   
   OUTPUT:

   RETVAL

#!/usr/bin/perl -w

use strict;
use warnings;
use ExtUtils::testlib;

use Hval;

use Data::Dumper;

my $txt=pack "C",255;

my $hash_ref = Hval::getnum($txt,length $txt,10);


foreach my $key (keys %$hash_ref) {
#  print "$key => $hash_ref->{$key}\n\n";
  print "$key => ".unpack "C",$hash_ref->{$key};
  print "\n";

}

[vilfred@mobile100 Hval]$ perl rr.pl
uns => 255
[vilfred@mobile100 Hval]$

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

MODULE = Hval            PACKAGE = Hval

SV *
getnum(char *data,int l,int k)

  INIT:

  CODE:
    
        HV* hash = newHV();

        AV* array = newAV();
        av_push(array, newSVnv(34)); 
        av_push(array, newSVnv(77)); 
        hv_store(hash, "unsigned_char",3, newSVpv ((char*) data, l*sizeof(data[0])), 0);

        hv_store(hash, "array",3,(SV*)array, 0);

      RETVAL = newRV( (SV *) hash ); 
    
  OUTPUT:

      RETVAL

#!/usr/bin/perl -w

use strict;
use warnings;
use ExtUtils::testlib;


use Hval;
use Data::Dumper;

my $txt=pack "C",255;
my $hash_ref = Hval::getnum($txt,length $txt,10);


foreach my $key (keys %$hash_ref) {
  print "$key => ";
  print join " | "=> @{$hash_ref->{$key}} if $key ne 'uns';
  print "\n\n";
  print "$key => ".unpack "C",$hash_ref->{$key} if $key eq 'uns';
  print "\n";

}
     

Обработка изображений

В gtk2-perl есть функция, позволяющая получать яркость пикселей в виде строки '\xff\x00...'. Т.к. зачастую при обработке изображений важна скорость работы программы, то по скорости get_pixels(), в принципе, может использоваться для обработки одиночных рисунков:

#!/usr/bin/perl

use strict;
use warnings;
use Glib qw(FALSE TRUE);

use Gtk2 -init;

use ExtUtils::testlib;
use HalfWork;

my(@criteria,@a,@res,$pix,$button,@m,$img,$pixbuf,$pixels,$w,$h,$c);



sub render_image{
  my ($txt1,$min, $max); $min=10; $max=440;
  $img=$ARGV[0] if $ARGV[0];
  $img=$_[0] if $_[0];
  $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ($img);
  $pixels = $pixbuf->get_pixels();
  $h = $pixbuf->get_height; $w = $pixbuf->get_width;

}
            
while (<$ARGV[0]/*.*>){
  print $c++," ";
  &render_image($_) if m!\.jpg$!;

}

[vilfred@mobile100 HalfWork]$ time perl fast.pl ../datchik/files/
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
79 80 81 82 83 84 85
real    0m2.230s
user    0m1.893s
sys     0m0.320s
[vilfred@mobile100 HalfWork]$ perl -e 'print 85/2.2,"\n"'
38.6363636363636
[vilfred@mobile100 HalfWork]$

Чтобы работать не с пикселями а с картинкой, т.е. сразу видеть результаты работы алгоритма, пишется, например, такой код:

#!/usr/bin/perl

use strict;
use warnings;

use Glib qw(FALSE TRUE);

use Gtk2 -init;
use ExtUtils::testlib;
use HalfWork;


my(@criteria,@a,@res,$pix,$button,@m,$img,$pixbuf,$pixels,$w,$h,$c);


my $window  = Gtk2::Window->new ( "toplevel" );
my $hbox    = Gtk2::HBox->new (1,1);

my $vbox    = Gtk2::VBox->new (0,1);
my $image   = Gtk2::Image->new;

my $e;

&images();

sub render_image{
  my ($txt1,$min, $max); $min=10; $max=440;


#  die "Usage: $0 imagefile\n" unless @ARGV;
  $img=$ARGV[0] if $ARGV[0];
  $img=$_[0] if $_[0];
  $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ($img);
  $pixels = $pixbuf->get_pixels();
  $h = $pixbuf->get_height; $w = $pixbuf->get_width;
  my $criteria;

  $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data
                        ($pixels,  # packed image data in a scalar
                           'rgb',  # only 24- or 32-bit RGB are supported
                               0,  # no alpha, data is 24-bit
                               8,  # only 8 bits per sample are supported
                              $w,  # in pixels
                              $h,  # in pixels
                            $w*3); # number of *bytes* in each row
                            
  $image->set_from_pixbuf ($pixbuf);
  $window->set_title("imaging $img");
  $img=''; $#res=-1;


}

$window->add($hbox);
$hbox->add($vbox);

$vbox->add($image);
$button = Gtk2::Button->new("Repaint...");
$button->signal_connect("clicked", \&signal);

$vbox->pack_start($button, 1, 1, 5);
$window->signal_connect( "destroy" , sub { Gtk2->main_quit ; } ) ;

$window->signal_connect (delete_event => sub {Gtk2->main_quit;});
$window->show_all();


eval {
Gtk2->main; };

my $cry;
open F,">$ARGV[0]/criteria.txt" or die "cant open: $!";


foreach (@criteria){ $cry+=$_ }
print F $cry/$#criteria," | ", print join " " => @criteria,"\n";


close F;
print "\nуТЕДОЕЕ ЪОБЮЕОЙЕ ЮЙУМБ НБЛУЙНХНПЧ: ",$cry/$#criteria,"\n";
exit 0;


sub signal {
  &render_image($m[$#m]) if $m[$#m] and -f $m[$#m];
  pop @m;
  Glib::Timeout->add (100,
  sub { $button->clicked; 0});

}

sub images{
  while (<$ARGV[0]/*.*>){

    $m[$c++]=$_ if m!\.jpg$!;
  }
  reverse @m;


}

[vilfred@mobile100 HalfWork]$ time perl wheather.pl ../datchik/files/

real    0m12.635s
user    0m2.565s
sys     0m0.453s
[vilfred@mobile100 HalfWork]$ perl -e 'print 85/11,"\n"'
7.72727272727273
[vilfred@mobile100 HalfWork]$

samolet | xs | next]]> https://rulinux.net/message.php?newsid=34868&page=1 https://rulinux.net/message.php?newsid=34868&page=1 Sat, 13 Feb 2010 21:20:00 +0300