Schlagwort: perl

Ein Kollege fragte mich heute, wie man in Perl nochmal Parameter an eine Funktion übergibt.

Das ist ja im Prinzip ganz einfach. Eine Funktion in Perl erhält als Übergabeparameter eine einfache Liste mit Namen @_. Aber damit fängt es dann erst an.

Nehmen wir mal an, wir haben eine einfache Funktion mit zwei Parametern:

sub twoParamFunction {
    my ($one, $two) = @_;
    print "$one and $twon";
}

Hier wird die Liste @_ einer Liste mit gerade frisch deklarierten Variablen zugewiesen. Es werden also alle zusätzlichen Parameter verworfen. Diese Art der Parameterübergabe ist vermutlich eine der gebräuchlichsten und einfachsten.

Aber natürlich war das nicht die Art der Übergabe, die mein Kollege im Sinn hatte. Also gut, wir können auch benannte Parameter mit Standard-Werten benutzen:

sub hashAsParam {
    my %hash_param = ( 
        'one' => 'Eins',
        'two' => 'Zwei',
        @_ );
    print "$hash_param{one} und $hash_param{two}n";
}

Hier wird die Liste in eine Hashstruktur eingeblendet und so können die benannte Parameter one und two sowohl übergeben, als auch weggelassen werden – dann erhalten sie eben ihre Standardwerte.

Aber ach, das war es auch nicht. Nun gut, wir können beide Methoden mischen:

sub mixedParams {
    my ($one, $two, %optional) = @_;
    print "$one and $twon";
    print join("; ", keys %optional) . "n";
}

Hier werden aus der Parameterlliste die ersten beiden Elemente $one und $two zugewiesen, und der Rest wird wie in hashAsParam einer Hashstruktur aufgehen. Wenn hierbei auch noch Standardwerte vorgegeben werden sollen, kann das in einer extra Zeile geschehen.

Hmhm, das war es auch nicht. Ok, wir können natürlich auch noch die Liste einzeln abarbeiten:

sub oneStep {
    my $one = shift;
    my $two = shift;
    print "$one and $twon";
}

Ja, genau das wars! Aber wo wir jetzt schon so viele Varianten hatten, können wir eine noch zusätzlich anbieten:

sub selectAFew {
    my ($one, $four) = @_[0,3];
    print "$one a $fourn";
}

Äh? Aber ab hier sollte eigentlich spätestens klar sein, dass man perldata und man perlsyn mal wieder besucht werden sollten. Um den ganzen die Krone aufzusetzen, kam mein Kollege eine halbe Stunde später wieder an. Diesmal wollte er aber die Möglichkeiten der Rückgaben aus Perl-Funktionen wissen…

Nachdem Jörg mir ein paar Perl-Bücher geliehen hatte und schon seit längerer Zeit das „Hello World!“ Plakat auf unserem stillen Örtchen hängt, musste ich mich einfach an einen Brainfuck Interpreter versuchen.

Und hier ist das Ergebnis:

#!/usr/bin/perl
{
  package BF;
  use strict;
  use warnings;

  my @REGISTERS=('PP', 'MP', 'LOOP');
  my %OPERATORS=(
      '+' => sub {
          my ($self) = @_;
          return if $self->{_registers}{'LOOP'} < 0;
          $self->{_memory}[$self->{_registers}{'MP'}]++;
          $self->{_registers}{'PP'}++;
      },
      '-' => sub {
          my ($self) = @_;
          return if $self->{_registers}{'LOOP'} < 0;
          $self->{_memory}[$self->{_registers}{'MP'}]--;
          $self->{_registers}{'PP'}++;
      },
      '.' => sub {
          my ($self) = @_;
          return if $self->{_registers}{'LOOP'} < 0;
          push @{ $self->{_output} }, $self->{_memory}[$self->{_registers}{'MP'}];
          $self->{_registers}{'PP'}++;
      },
      '>' => sub {
          my ($self) = @_;
          return if $self->{_registers}{'LOOP'} < 0;
          $self->{_registers}{'MP'}++;
          $self->{_registers}{'PP'}++;
      },
      '<' => sub {
          my ($self) = @_;
          return if $self->{_registers}{'LOOP'} < 0;
          $self->{_registers}{'MP'}--;
          $self->{_registers}{'PP'}++;
      },
      '[' => sub {
          my ($self) = @_;
          if ($self->{_memory}[$self->{_registers}{'MP'}] > 0) {
              push @{ $self->{_stack} }, $self->{_registers}{'PP'};
          } else {
              $self->{_registers}{'LOOP'}--;
          }
          $self->{_registers}{'PP'}++;
          return;
      },
      ']' => sub {
          my ($self) = @_;
          my $loop_stacktart = pop @{ $self->{_stack} };
          if ($self->{_memory}[$self->{_registers}{'MP'}]) {
              $self->{_registers}{'PP'} = $loop_stacktart;
          } else {
              $self->{_registers}{'PP'}++;
          }
          $self->{_registers}{'LOOP'}++;
      },
  );

  sub new {
      my $class = shift;
      my $data = {
          _registers => { map { $_ => 0 } @REGISTERS },
          _memory => [],
          _stack => [],
          _output => [],
      };
      bless $data, $class;
  };

  sub run {
      my $self = shift;
      while ($self->{_registers}{PP} < $self->{_max_program_size}) {
          my $op_char = $self->{_program}[$self->{_registers}{PP}];
          my $op = $OPERATORS{$op_char};
          $op->($self);
      }
  }

  sub set_memory {
      my ($self, $memory) = @_;
      $self->{_program} = [ split //, $memory ];
      $self->{_max_program_size} = @{ $self->{_program} };
  }

  sub output {
      my $self = shift;
      return join ',', @{ $self->{_output} };
  }

  sub char_output {
      my $self = shift;
      return join '', map { chr($_) } @{ $self->{_output} };
  }
}

package main;
use strict;
use warnings;

use Test::More qw(no_plan);

my %test_data = (
    '++.' => '2',
    '++-.' => '1',
    '++.>+.<+.' => '2,1,3',
    '+++.[-.].' => '3,2,1,0,0',
    '++.[->++[.-]<]' => '2,2,1,2,1',
    '++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.' => '72,101,108,108,111,32,87,111,114,108,100,33,10',
);
while (my ($prog, $exptected_output) = each %test_data) {
    my $bf = BF->new();
    $bf->set_memory($prog);
    $bf->run();
    is($bf->output(), $exptected_output, $prog);
}

my $bf = BF->new();
$bf->set_memory('++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.');
$bf->run();
is("Hello World!n", $bf->char_output(), "Hello World!");

Eine tolle sinnlose Beschäftigung.

Und wen es interessiert: Das Plakat zum Programm.

Warum Prototypen nur in den seltensten Fällen sinn machen.

Nachdem ich vor einiger Zeit schon mal über einen Sprachwechselfehler in einem meiner Perl Skripte gestossen bin.

Ich hatte eine Funktion wie folgt deklariert:

sub func1() {
    my $var = shift;
    ...
}

Und der Perl Compiler mäkelte irgendwas vonwegen too many arguments… Klar das () weist Perl an, das diese Funktion keine Parameter bekommen darf. Also das () entfernt und alles war wieder gut.

Objekte und Prototypen

Dann bin ich jetzt über eine Code Stelle gestossen, die folgendermassen als Methode in einem Objekt deklariert war:

sub method1( $ ) {
    my $self = shift;
    ....
    my $var = shift;
    ...
}

Da wollte der Autor wohl festhalten, dass diese Methode nur einen Parameter annimmt, und hat das $var=shift später übersehen, oder hat sich gedacht, $self=shift würde vorher ausgewertet werden. Es ist aber so, dass in Methodenaufrufen die Protoypen ignoriert werden.

Als Funktion aufgerufen macht die method1() aber auch nicht das was sie soll, da $self mit hoher Wahrscheinlichkeit nicht den richtigen Inhlat hat.

Praktisch sind sie aber doch

Zum Beispiel um eine Funktion wie grep nachzubauen:

sub my_grep(&@) {
    my ($grepper, @list) = @_;
    my @result = ();
    foreach (@list) {
        push @result, $_
          if ($grepper->());
    }
    return @result;
}

Diese Funktion kann dann wie das eingebaute grep benutzt werden:

my @odd = my_grep { $_[0] % 2 } ( 1 .. 20 );

Da nutzt man seit Jahren Perl, und dann so was…

In Perl werden Schleifenvariablen über Arrays (und Hashes) als Aliase genutzt. Verändert man diese, so verändert man die Inhalt in den Arrays.

#!/usr/bin/perl
use warnings;
use strict;

use Test::More qw(no_plan);

my @names = qw( Felix Urte Sven );
for my $name (@names) {
    $name =~ s/e//;
}

my @new_names = qw( Flix Urt Svn );
is_deeply( @names, @new_names );

Bisher ist mir das nie aufgefallen. Hoffentlich habe ich tatsächlich nirgendwo solche Nebeneffekte produziert.

Oioioioi…