Dear Monks,
Herein lies my latest half-baked Perl extension. This one is for reducing the amount of boiler-plate code necessary for writing Perl subs.
As per usual, I will jump right to the code which I always assume will speak for itself ( but rarely does ).
Here is an example of a module that uses my "handy" new module.
SomeTestPackage2.pm
package SomeTestPackage2;
use strict;
use warnings;
use Data::Dumper;
use constant IVARS => qw[$none $href $aref $non_empty_aref];
BEGIN {
use base qw[SomeAttributes2];
__PACKAGE__->import( IVARS );
}
use constant custom_aref => q{ confess( '!!!package!!! !!!ivar!!! m
+ust be an array ref' ) if 'ARRAY' ne ref !!!ivar!!!; };
sub self_sub : Method( qw/ $none :none $href :href $aref custom_aref $
+non_empty_aref :non_empty_aref / ) { #
return ( ref $self, ref $href, ref $aref, scalar @{ $non_empty_are
+f } );
}
1;
The previous code snip shows how the meta programming interface works for the most part.
First, you specify a list of instance variables, or whatever, that you would like to pull into subs. This pre-declaration is necessary for syntax reasons.
Next, you can specify "custom" attributes as package subs if you desire. The difference between a custom attribute and a canned/common one is that canned attributes begin with a colon and custom do not.
Now, in your sub attribute you specify a list of variables you'd like pulled into your sub along with any attributes you'd like called on them.
This is the test script running the prior code
test2.pl
#!/usr/bin/perl
use strict;
use warnings;
use Test::More qw[no_plan];
use SomeTestPackage2;
do { # Successfull call to self_sub
my( $test1 ) = bless( {}, 'SomeTestPackage2' );
my( @self_sub ) = $test1->self_sub( 'hi', { }, [ ], [ 1 ] );
ok( $self_sub[0] eq 'SomeTestPackage2', 'ref $self' );
ok( $self_sub[1] eq 'HASH', 'ref $href' );
ok( $self_sub[2] eq 'ARRAY', 'ref $aref' );
ok( $self_sub[3] > 0, 'non empty array' );
};
Here is the output of running the previous script.
$ perl test2.pl
ok 1 - ref $self
ok 2 - ref $href
ok 3 - ref $aref
ok 4 - non empty array
1..4
And finally, here is the code that is compiled from the "Method" attribute on the "self_sub".
sub {
local *__ANON__='SomeTestPackage2::self_sub';
my( $self, $none, $href, $aref, $non_empty_aref ) = @_;
confess( 'SomeTestPackage2::self_sub $non_empty_aref needs a non-e
+mpty array reference' ) if 'ARRAY' ne ref $non_empty_aref or not @{ $
+non_empty_aref };
confess( 'SomeTestPackage2 $aref must be an array ref' ) if 'ARRAY
+' ne ref $aref;
confess( 'SomeTestPackage2::self_sub $href needs a hash reference'
+ ) if 'HASH' ne ref $href;
confess( 'SomeTestPackage2::self_sub needs a SomeTestPackage2 refe
+rence' ) if ref $self ne 'SomeTestPackage2';
package SomeTestPackage2;
use warnings;
use strict 'refs';
return ref $self, ref $href, ref $aref, scalar @{$non_empty_aref;}
+;
}
That's it! Is it crap?