Скрыть 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

Далее нужно сказать perl Makefile.PL, потом make. Вызов модуля при помощи программы

#/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

Функция massiv вызывается как-то так:

#/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

Perl код такой:

#/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

В случае, если не написать unsigned char а просто char, то значения передаваемой переменной будут изменяться в диапазоне от -128 до 128, что испортит картину, написанную маслом.

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

возвращает ссылку на хеш, функцию Hval::getnum можно вызвать так:

#!/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]$ 

Передача и возврат данных в виде "\x00\ff..." etc... через хэш:

#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]$

Создание хеша с именоваными ключами и значениями в виде массива и строки в виде \x00\xff...

#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

Возвращается хеш с двумя элементами: массивом и строкой unsigned char в виде '\x00\xff...'

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

}
     

Работа с параллельным портом при помощи xs

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

В 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]$

38 кадров 640x480 в секудну.

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

#!/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]$

т.е. около 8 кадров в секунду. Скриншот программы:

samolet | xs | next