Friday, June 05, 2009

Mit Attribute::Handlers den Kontext eines Funktionsaufrufs erzwingen

Bei Perl-Community.de kam in dieser Woche die Frage auf, wie man als Programmierer bestimmen kann, dass eine Subroutine in einem bestimmten Kontext aufgerufen werden kann. Ich weiß zwar nicht, ob diese Frage wirklich so häufig aufkommt, aber mir ist als erstes das Stichwort "Attribute" in den Sinn gekommen. In der Ausgabe 5 von $foo habe ich schonmal was über "Attribute" geschrieben.

Hier jetzt mal meine Lösung für das Kontext-Problem:

package CheckContext;

use strict;
use warnings;

use Attribute::Handlers;

sub VOID : ATTR(CODE) {
my ($pkg,$sym,$code) = @_;

my $name = *{$sym}{NAME};
no warnings 'redefine';

*{ $sym } = sub {
my $context = wantarray;
if( defined $context ) {
die "sub have to be called in void context";
}

$code->( @_ );
}
}

sub SCALAR : ATTR(CODE) {
my ($pkg,$sym,$code) = @_;

my $name = *{$sym}{NAME};
no warnings 'redefine';

*{ $sym } = sub {
my $context = wantarray;
unless( defined $context and not $context ) {
die "sub have to be called in scalar context";
}

$code->( @_ );
}
}

sub LIST : ATTR(CODE) {
my ($pkg,$sym,$code) = @_;

my $name = *{$sym}{NAME};
no warnings 'redefine';

*{ $sym } = sub {
my $context = wantarray;
unless( defined $context and $context ) {
die "sub have to be called in list context";
}

$code->( @_ );
}
}

1;


Dieses Modul stellt die notwendigen Attribute zur Verfügung. Mit wantarray bekommt man raus, in welchem Kontext die Subroutine aufgerufen wurde.

In der folgenden Klasse, werden die Attribute verwendet:
package CheckTest;

use strict;
use warnings;
use base 'CheckContext';

sub test : VOID {
print 'hallo';
}

sub zwo : SCALAR {
return 'hallo';
}

sub drei : LIST {
return (1,2,3);
}

1;


Im Skript können die Funktionen dann verwendet werden...

CheckTest::test(); # 'hallo'
my $test = CheckTest::test(); # sub have to be called in void context at CheckContext.pm line 17.
my @test = CheckTest::test(); # sub have to be called in void context at CheckContext.pm line 17.


my $zwo = CheckTest::zwo();
my @zwo = CheckTest::zwo(); # sub have to be called in scalar context at CheckContext.pm line 33.
CheckTest::zwo(); # sub have to be called in scalar context at CheckContext.pm line 33.

No comments: