Динамические возможности Perl Валерий Студенников despair [at] reg.ru 2010. - презентация

1 Динамические возможности Perl Валерий Студенников despair [at] reg.ru 2010

2 Динамический язык? Динамический язык позволяет осуществлять синтаксический анализ и компиляцию «на лету», непосредственно на этапе выполнения. (c) Wikipedia Динамический язык позволяет менять код / структуру программы во время выполнения; Perl – динамический язык. В Perl «На лету» (уже после загрузки / компиляции приложения) можно делать ВСЁ.

3 Символические ссылки # ${ $ref $ref } %{ $ref } \&{ $ref } # no strict, should build & run ok my $fred ; $b = "fred" ; $a = $$b ; $c = ${"def"} ; $c ; $c = %{"def"} ; $c = *{"def"} ; $c = \&{"def"} ;

4 Как избежать предупреждений ${'XXX'} = 123; # Получаем: Can't use string ("XXX") as a SCALAR ref while "strict refs" in use at - line YYY. # Боремся так: { no strict 'refs'; # Здесь делаем грязные дела… } Can't use string ("XXX") as a SCALAR ref while "strict refs" in use at - line YYY. # Боремся так: { no strict 'refs'; # Здесь делаем грязные дела… }

5 Обращение к переменной по имени $var = = (1); %var = (1, 2); $name = 'var'; print %{$name}; print ${__PACKAGE__.'::'.$name}; print eval '$name';

6 Создание переменных на лету $varname = 'myname'; ${$varname} = 123; ${__PACKAGE__.'::'.$varname} = 123; eval \$$varname = 123;

7 Typeglobs *this = *that; local *Here::blue = \$There::green; $fh = *STDOUT; $fh = \*STDOUT; *dick = \$richard; *dick = *dick = \%richard;

8 Выполнение произвольного кода # Используется для отлова исключений: eval {}; # Выполнить произвольный код eval "print 123"; # eval не нужно злоупотреблять! Пример: создание функции на лету # Создаст функцию и сразу поместит в namespace eval 'sub sqr { $_[0] * $_[0] }'; print sqr( 2 );

'test', username => 'test', pass =>" title="Выполнение кода из файла # Загрузить и выполнить содержимое файла do $filename; # Эквивалент "do": eval `cat $filename` # Так можно сделать простейшие конфиги # Хотя это и не рекомендуется.... $config = ( dbname => 'test', username => 'test', pass =>" class="link_thumb"> 9 Выполнение кода из файла # Загрузить и выполнить содержимое файла do $filename; # Эквивалент "do": eval `cat $filename` # Так можно сделать простейшие конфиги # Хотя это и не рекомендуется.... $config = ( dbname => 'test', username => 'test', pass => 'sdsfdf' ); 'test', username => 'test', pass =>"> 'test', username => 'test', pass => 'sdsfdf' );"> 'test', username => 'test', pass =>" title="Выполнение кода из файла # Загрузить и выполнить содержимое файла do $filename; # Эквивалент "do": eval `cat $filename` # Так можно сделать простейшие конфиги # Хотя это и не рекомендуется.... $config = ( dbname => 'test', username => 'test', pass =>">

10 perl -MData::Dumper -e 'print Dumper( \%INC )' $VAR1 = { 'warnings/register.pm' => '/usr/lib/perl5/5.10.0/warnings/register.pm', 'bytes.pm' => '/usr/lib/perl5/5.10.0/bytes.pm', 'XSLoader.pm' => '/usr/lib/perl5/5.10.0/i386-linux-thread-multi/XSLoader.pm',... 'Data/Dumper.pm' => '/usr/lib/perl5/5.10.0/i386-linux-thread-multi/Data/Dumper.pm' }; perl -MCGI -e 'print( join "\n", sort keys %INC );' CGI.pm CGI/Util.pm Carp.pm Exporter.pm... perl -e 'print join perl -MData::Dumper -e 'print Dumper( \%INC )' $VAR1 = { 'warnings/register.pm' => '/usr/lib/perl5/5.10.0/warnings/register.pm', 'bytes.pm' => '/usr/lib/perl5/5.10.0/bytes.pm', 'XSLoader.pm' => '/usr/lib/perl5/5.10.0/i386-linux-thread-multi/XSLoader.pm',... 'Data/Dumper.pm' => '/usr/lib/perl5/5.10.0/i386-linux-thread-multi/Data/Dumper.pm' }; perl -MCGI -e 'print( join "\n", sort keys %INC );' CGI.pm CGI/Util.pm Carp.pm Exporter.pm... '/usr/lib/perl5/5.10.0/warnings/register.pm', 'bytes.pm' => '/usr/lib/perl5/5.10.0/bytes.pm', 'XSLoader.pm' => '/usr/lib/perl5/5.10.0/i386-linux-thread-multi/XSLoader.pm',... 'Data/Dumper.pm' => '/usr/lib/perl5/5.10.0/i386-linux-thread-multi/Data/Dumper.pm' }; perl -MCGI -e 'print( join "\n", sort keys %INC );' CGI.pm CGI/Util.pm Carp.pm Exporter.pm...">

11 Подгрузка модулей на лету require $filename; # Безопасная одноразовая загрузка модулей sub use_once ($) { my ($module) my $module_file = $module.'.pm'; $module_file =~ s/::/\//xmsg; unless ($INC{$module_file}) { eval { require $module_file } or return; import $module; } return 1; }

12 Вызов функции / метода по имени $subname = 'sqr'; # Вызов функции по имени $subname->(2); &$subname( 2 ); *{$subname}->(2); # Вызов функции пакета __PACKAGE__->$subname(2); main->$subname(2); # Вызов метода по имени $object->$subname(2);

13 Вызов функции из неизвестного пакета $package = 'MyPackage'; # Имя функции известно заранее: $package->action(); # Имя функции заранее не известно: $subname = 'action'; ); # Первым аргументом будет передано название пакета! &{ $package. '::'. $subname );

14 Получить ссылку на функцию $packagename = 'MyPackage'; $subname = 'sqr'; # Из своего пакета: $ref = \&{$subname}; # Предпочтительнее $ref = *{$subname}; # Из чужого пакета $ref = \&{ $packagename. '::'. $subname }; $ref = *{ $packagename. '::'. $subname };

15 Вызов функции по ссылке my $ref; # Ссылка на функцию ); ); goto &$ref; # Будет задействован goto &$AUTOLOAD;

16 Запись функции в пространство имён $subname = 'alias'; $packagename = 'MyPackage'; # Записываем в namespace текущего пакета *{$subname} = \&sqr; alias( 4 ); # Записываем в namespace произвольного пакета *{"${packagename}::$subname"} = $coderef; $packagename->alias(2); alias(2);">

17 Способы переопределения функции # 1 package A; sub test { 1 }; package B; sub A::test { 2 }; print A::test(); # prints 2 # 2 *{"A::test"} = $coderef; # 3 package A; sub test { 1 }; package B; 1; package A; sub test { 2 }; package B; print A::test(); # prints 2

18 Просмотр содержимого namespace package A; = (1,2,3); sub two { 2 }; package main; print Dumper(\%{*{A::}}); # A:: typeglob # 'a' => *A::a, # 'two' => *A::two print Dumper( *{A::a}{ARRAY} ); # SCALAR | ARRAY | HASH | CODE | IO # PACKAGE | NAME

19 Замыкания sub outer_sub { $variable = shift; sub inner_sub { print $variable; }

get_account_balance; # В" title="Пример применения замыканий: accessors sub make_ro_accessor { my($class, $field) = @_; my $subref = sub { my $self = shift; return &{*{"${class}::get"}}($self, $field); }; *{"${class}::get_$field"} = $subref; } print $object->get_account_balance; # В" class="link_thumb"> 20 Пример применения замыканий: accessors sub make_ro_accessor { my($class, $field) my $subref = sub { my $self = shift; return &{*{"${class}::get"}}($self, $field); }; *{"${class}::get_$field"} = $subref; } print $object->get_account_balance; # Вызов аналогичен $object->get('account_balance'); get_account_balance; # В"> get_account_balance; # Вызов аналогичен $object->get('account_balance');"> get_account_balance; # В" title="Пример применения замыканий: accessors sub make_ro_accessor { my($class, $field) = @_; my $subref = sub { my $self = shift; return &{*{"${class}::get"}}($self, $field); }; *{"${class}::get_$field"} = $subref; } print $object->get_account_balance; # В">

21 AUTOLOAD: пример 1 sub AUTOLOAD { our $AUTOLOAD; return "I see } print blarg(123); # prints «I see main::blarg(123)» sub AUTOLOAD { our $AUTOLOAD; return "I see } sub AUTOLOAD { our $AUTOLOAD; return "I see } print blarg(123); # sub AUTOLOAD { our $AUTOLOAD; return "I see } print blarg(123); #

22 AUTOLOAD: пример 2 sub AUTOLOAD { my $package = my $name = our $AUTOLOAD; *$AUTOLOAD = sub { print "I see }; goto &$AUTOLOAD; # Restart the new routine. } blarg(30); # prints: I see main::blarg(30) glarb(40); # prints: I see main::glarb(40) blarg(50); # prints: I see main::blarg(50)

23 overload use overload '+' => \&myadd, '-' => \&mysub; use Number::Fraction ':constants' my $f1 = '1/2'; print $f1 + 1/3; # prints '5/6'

24 Перезаписывание объектов чужого пакета package = 123; sub bar { 1234 }; package B; # Перезаписываем функции / переменные пакета package = 456; sub bar { 5678 }; # Теперь доступны перезаписанные версии package main; print A::bar();

25 caller кто нас вызвал? ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller($i); ($package, $filename, $line) = caller; # Можем получить аргументы вызывающих функций и фактически вручную получить полный backtrace package

26 Devel::Caller Devel::Caller - meatier versions of caller caller_cv($level) Возвращает coderef вызвающей функции caller_args($level) Возвращает аргументы вызывающей функции caller_vars( $level, $names ) Возвращает ссылки на переданные аргументы или имена (!) аргументов called_as_method($level) Была ли вызвана подпрограмма как метод?

27 Devel::Declare Определение новых ключевых слов / синтаксических конструкций # Например: method foo ($arg1, $arg2) {... } => sub foo { my ($self, $arg1, $arg2) }

28 PadWalker PadWalker - play with other peoples' lexical variables peek_my LEVEL peek_our LEVEL peek_sub SUB closed_over SUB set_closed_over SUB, HASH_REF var_name LEVEL, VAR_REF var_name SUB, VAR_REF

29 Где это может быть полезно? Выход в «четвёртое измерение»; Всевозможные хаки; Исправление поведения чужих модулей.

30 Пример :: Template Toolkit # # Compiled template generated by the Template Toolkit version 2.22 # I see main::blarg(123) Template::Document->new({ METADATA => { 'modtime' => ' ', 'name' => 'header.inc', }, BLOCK => sub { my $context = shift || die "template sub called without context\n"; my $stash = $context->stash; my $output = ''; my $_tt_error; eval { BLOCK: { #line 1 "/www/srs/templates/regru/header.inc" # MACRO $stash->set('marker', sub { my $_tt_params = $_[0] if ref($_[0]) eq 'HASH'; my $output = ''; my $stash = $context->localise($_tt_params); eval { $output.= ' ► '; }; $stash = $context->delocalise(); die if return $output; }); #line 2 "/www/srs/templates/regru/header.inc" # MACRO $stash->set('marker2', sub { my $_tt_params = $_[0] if ref($_[0]) eq 'HASH'; my $output = ''; my $stash = $context->localise($_tt_params); eval { $output.= ' '; }; $stash = $context->delocalise(); die if return $output; });... stash; my $output = ''; my $_tt_error; eval { BLOCK: { #line 1 "/www/srs/templates/regru/header.inc" # MACRO $stash->set('marker', sub { my $_tt_params = $_[0] if ref($_[0]) eq 'HASH'; my $output = ''; my $stash = $context->localise($_tt_params); eval { $output.= ' ► '; }; $stash = $context->delocalise(); die $@ if $@; return $output; }); #line 2 "/www/srs/templates/regru/header.inc" # MACRO $stash->set('marker2', sub { my $_tt_params = $_[0] if ref($_[0]) eq 'HASH'; my $output = ''; my $stash = $context->localise($_tt_params); eval { $output.= ' '; }; $stash = $context->delocalise(); die $@ if $@; return $output; });...">

31 Что почитать perlmod: typeglob: perldata ("Typeglobs and Filehandles"): Typeglobs and Filehandles