Få programmeringsspråk är så anpassningsbara som Perl5. Detta gäller inte bara på den syntaxiska nivån utan också internt hur op-trädet byggs upp och exekveras. Denna flexibilitet har tyvärr gett Perl ett ibland inte välförtjänt rykte och framförallt lett till att det till skillnad från många andra språk bara finns en kompilator och VM. Python t.ex. har multipla implementationer – CPython (originalet), Jython (JVM) och IronPython (CLR) för att nämna några.

Perl5 är i skrivande stund (nov 2011)  17 år gammalt och genom åren har det tillkommit mycket ny funktionalitet i kärnan och på CPAN finns allt mellan himmel och jord så som bryggor mot andra språk, MOPs, alternativa runloops, källkodsfilter osv.

Jag tänkte i denna del ta upp tre grundläggande tekniker som inte kräver någon direkt djupare förståelse av hur det funkar internt – prototyper, attribut och källkodsfilter. Viss kunskap om referenser och moduler är dock nödvändigt. Hur man manipulerar op-trädet, definierar egna nyckelord och implementerar alternativa runloops och annat godis kommer i del 2 (och 3 om det blir mycket).

Prototyper

I Perl5 deklarerar man inte argumenten till en subrutin som i t.ex. C utan dessa kommer i variablen @_. Perl5 har dock något som kallas för prototyper som tyvärr allt för många misstar för att vara formella argument deklarationer. Prototyper har ett och endast ett användningsområde; när man vill påverka hur parsern (dvs det som tolkar vad källkoden betyder) tolkar funktionsanrop. Vi kan illustrera detta genom följande exempel tar två skalära argument

sub test($$) {
  my ($x, $y) = @_;
}

Givet @a = (1..5); @b = (10..15) så gör anropet test @a, @b; att $x och $y får värdet 5 vilket är längden på respektive array, vilket man får om man använder en array i skalar kontext. Anropet &test(@a, @b) kommer dock ge $x värdet 1 och $y värdet 2 vilket är de två första elementen i @a. Varför? jo, för anrop med & och parenteser ignorerar prototypen. Prototyper ignoreras också när det är metodanrop och kräver att deklarationen av subrutinen setts av parsern innan något anrop.

Vad prototyper är till för då? Jo, för att kunna emulera syntaxen för vissa built-ins t.ex. push, grep och map. Prototyper är compile-time vilket innabär att dom kollas när ditt program kompileras. Hur perl transformerar din kod till något körbart kommer tas upp i framtida delar eller separata artiklar.

Låt oss kolla på ett riktigt exempel: hur vi skapar en funktion som för en varje element i en lista testar den mot ett uttryck och om alla är sanna returnerar sant – dvs, precis det som all från List::MoreUtils gör.

sub all(&@) {
  my $f = shift;
  $f->() or return 0 for @_;
  return 1;
}

my $ok = all { $_ =~ /oo+/ } "foo", "fooo", "foooo";

Prototypen &@ innebär att vi förväntar oss en referens till en subrutin och @ att resten är en lista. Vi skulle kunna anropa den som all \&check, ”foo”, ”fooo”, ”foooo” eller ge den en anonym subrutin istället. När & förekommer först i prototypen kan vi dock utelämna sub och ge den vad till synes är ett block istället.

En annan rätt händig prototyp är den tomma () vilket innebär att funktionen inte tar några argument alls. Det gör vi kan skapa vår egna implementation av time och kan skriva mytime +4 och den tolkar detta som mytime() + 4 istället för mytime(+4). En tom prototyp används också för att skapa konstanter som optimeraren ersätter med det faktiska värdet.

Prototyper gör att man kan skapa suba egna små DSL (domän specifika språk) tämligen enkelt men skall inte användas för att kolla att antal argument är rätt. Mer information om prototyper finns i perlsub.

Attribut

Variabler och subrutiner kan annoteras med attribut vilket ger en möjlighet att ge dem speciella egenskaper eller på annat sätt agera . Attribut är dock inte så vanligt förekommande och anses fortfarande lite lätt experimentellt. Jag vill ändå visa hur det kan användas.

Jag har en modul, JSON::RPC::Simple, på CPAN för att exponera klasser och metoder som JSON-RPC 1.1wd . Den använder attribut för att annotera vilka subrutiner i mina klasser som skall vara anropbara via JSON-RPC.

package MyApp::API;

use base qw(JSON::RPC::Simple);

sub new { return bless {}, shift };

sub echo : JSONRpcMethod(Arg1, Arg2, Arg3) {
  my ($self, $request, $args) = @_;
}

1;

Det intressanta i koden ovanför är JSONRpcMethod attributet efter sub echo. Det används för att markera att just denna metod är en JSON-RPC metod med namnsatta argument och dessa är Arg1, Arg2 och Arg3 . Vad som händer internt är dock lite mer spännande. Om det vid compile-time finns en MODIFY_CODE_ATTRIBUTES i det aktiva paketet eller något man ärver kommer denna anropas och vi kan manipulera det vi annoterar om så önskas. Vi är dock bara intresserade av deklarationen och vill inte göra någon manipulation. Här är implementationen:

my %method_attributes;

my $method_attr_re = qr{
  ^
  JSONRpcMethod
  (?:\(\)|\(
    \s*
    (\w+ (\s*,\s* \w+)*)?
    \s*
  \))?
}sx;

sub MODIFY_CODE_ATTRIBUTES {
  my ($class, $code, @attributes) = @_;

  # Check if this contains a JSONRpcMethod attribute
  my @bad;
  for my $attribute (@attributes) {
    if ($attribute =~ $method_attr_re) {
      my @attrs = split /\s*,\s*/, ($1 || "");
      $method_attributes{refaddr $code} = \@attrs;
    }
    else {
      push @bad, $attribute;
    }
  }

  return @bad;
}

Trots att vi kan annotera med flera attribut, t.ex. sub foo :this :that {}, så anropas MODIFY_CODE_ATTRIBUTE endast en gång och med alla attribut som är definierade. Denna subrutin förväntas returnera en lista på alla dåliga attribut som den inte kan hantera och då kommer kompileringen att avbrytas. Som första argument kommer namnet på det aktiva paketet, som andra argument en referens till en subrutin och sedan alla definierade attribut. Dessa är bara text så de måste manuellt tolkas som i mitt fall med ett reguljärt uttryck. Varje attribut är ett namn följt av frivillig data inom balanserade parenteser. Då vi bara får en referens till subrutinen och inte dess faktiska namn så måste man kolla upp det om det behövs ( B::svref_2object($ref)->GV->NAME ).

Om attributet matchar vårt reguljära uttryck så sparar vi argumenten i en hash där nyckeln är addressen till vår subrutin. Då våra subrutiner inte flyttar på sig så kan vi använda detta senare för att få ut informationen.

Nu när kompileringen är klar och allt har gått bra vill vi använda det vi precis gjort. I JSON-RPC bryggan binder man klasser eller objekt till en sökväg så t.ex. /api hanteras av MyApp::API. JSON-RPC anropet anger ett namn och detta använder vi för att få ut motsvarande metod med samma namn via $obj->can($method). can är en metod i UNIVERSAL vilket innebär att den ärvs av alla klasser och denna returnerar en referens till subrutinen som skulle anropas om vi gjorde ett vanligt metodanrop. Denna referens address kollar jag sedan upp i %method_attributes och får på så sätt namnen på argumenten. Inte speciellt krångligt så länge man har en typ av attribut på en datatyp bara…

Men, för att göra det enklare att skriva attribut finns det en väldigt praktisk hjälpmodul som tillhandahåller ett attribut-baserat API för deklarera nya attribut, nämligen Attribute::Handlers. Säg att vi vill göra en skalär typ som bara accepterar numeriska värden inom ett visst område. Den syntax vi vill använda är

my $x : Range(1, 20) = 15;

Vi börjar dock med att implementera typen vilket via gör enkelt via tie mekanismen. Detta exempel är väldigt förenklat och mer felkontroll borde göras men det duger som exempel.

package Range;

use strict;
use warnings;
use Carp;

sub TIESCALAR {
  my ($class, $min, $max) = @_;
  bless { min => $min, max => $max, value => $min }, $class;
}

sub FETCH { shift->{value}; }

sub STORE {
  my ($self, $value) = @_;
  if ($value < $self->{min} || $value > $self->{max}) {
    croak "Value $value out of range"
  }
  $self->{value} = $value;
}

1;

Normala sättet att använda denna är genom tie my $x, ”Range”, 1, 20; vilket gör $x till en tied variabel. Nu skall vi dock lägga till så vi kan göra detta via ett attribut istället och använder då Attribute::Handlers. Vi lägger till följande innan sista raden (1;)

use Attribute::Handlers;

sub Range : ATTR(SCALAR) {
  my (undef, undef, $referent, $attr, $data) = @_;
  my ($min, $max) = @$data;
  tie $$referent, 'Range', $min, $max;
}

sub import {
  my $caller_pkg = (caller)[0];
  no warnings;
  eval qq{
    sub ${caller_pkg}::Range : ATTR(SCALAR) {
      goto &Range::Range;
    }
  };
}

Första raden säger att vi vill ladda Attribute::Handlers och importera eventuella funktioner det exporterar automatiskt. sub Range : ATTR(SCALAR) är vårt nya attribut som är tillämpningsbart på skalärer och som skall anropas varje gång man skapar använder just Range attributet. Det vi är intresserade av är variablen ($referent) som vi får en referens till och argumenten till attributet ($data). Attribute::Handlers är så smidigt så den försöker tolka det som står inom () efter attributet och göra det till en vettig datastruktur i vårt fall en array referens. Nästa steg är helt enkelt att anropa tie på den faktiska variabeln, därav derefereringen.

Vår import funktion, den anropas automtiskt vid use , sätter upp attributet i det anropande paketet. Lite magi men det är så Attribute::Handlers måste göra om man vill göra sina attribute tillgängliga utanför där man deklarerat dom.

En provkörning senare och vi är i mål!

$ perl -MRange -E 'my $x : Range(10, 20); $x = 25'
Value out of range at -e line 1

Källkodsfilter

Den sista saken jag tänker ta upp är källkodsfilter och samtidigt höja ett varningens finger för att använda detta då det är en enkel källa för fel som är svåra att diagnostisera. Modulen Switch som implementerar en switch/case liknande syntax är ett bra exempel på hur fel det kan bli. Sedan 5.10 finns dock given/when implementerat som är en kraftfull variant av switch/case.

Vi ska göra ett extremt enkelt filter som ersätter alla alla förekomster av WHERE_AM_I;  med en print till STDERR var man är någonstans. Vi kommer att nyttja Filter::Simple vilket är ett enkelt API till källkodsfiltreringen.

package WhereAmI;

use Filter::Simple;

FILTER {
  s{\bWHERE_AM_I;}
   {print STDERR "I'm at line ", __LINE__,
                 " in ", __FILE__, "\n";}g;
}

1;

Vårt filter förändrar källkoden som vi får i $_ i FILTER funktionen. Vi ersätter WHERE_AM_I; med var vi är någonstans. Vi använder oss av __LINE__ och __FILE__ vilket är nuvarande raden och filen som parsern behandlar. Ska man vara petig kan man likt cpp sätta vilken rad man är på med en speciell #line <nr> kommentar så det är inte nödvändigtvis den faktiska fysiska raden i filen.

Testskriptet vi kör detta på ser ut som följande

use WhereAmI;

print "Before\n";
WHERE_AM_I;
print "After\n";

En testkörning och vi får

$ perl foo.pl
Before
I'm at line 4 in foo.pl
After

Om vi kollar på vad perl kompilerade så skickar vi det genom B::Deparse som omvandlar op-trädet tillbaks till källkod.

$ perl -MO=Deparse foo.pl
use WhereAmI;
print "Before\n";
print STDERR q[I'm at line ], '4', ' in ', 'foo.pl', "\n";
print "After\n";

Som synes så har vårt filter gjort om källkoden till det vi ville. perl har också ersatt __LINE__ och __FILE__ med konstanter.

Källkodsfilter kan man använda till mycket roligt men bör inte användas till någonting seriöst just för att det involverar att tolka Perl vilket är extremt svårt att göra rätt. Kanske hört uttrycket ”only perl can parse Perl”?

Om du ändå känner för att dyka djupare kolla på Filter::Util::Call vilket är det normala Perl APIet. Läs också perlfilter och kolla på Lingua::Romana::Perligata som finns på CPAN – ett ypperligt exempel på galenskapen som kan åstakommas.

 

Nästa gång ska vi dyka djupare in och se hur vi kan manipulera det som kompilerats.

 

Lämna ett svar

E-postadressen publiceras inte. Obligatoriska fält är märkta *

*

Följande HTML-taggar och attribut är tillåtna: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

Creative Commons License
Copyright © FOSS-Magasin & respektive artikels författare
Licenserat under Creative Commons Attribution-ShareAlike 3.0 Unported License om inte annat angivet.