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;

[download]

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' );
};

[download]

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

[download]

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;}
+;
}

[download]

That's it! Is it crap?

Replies are listed 'Best First'.
Re: RFC: Perl meta programming
by chromatic (Archbishop) on Oct 19, 2006 at 21:09 UTC

    Using ref is almost always wrong, especially for objects. I almost can't think of a case where it's right -- but serialization code might need to use it.

[reply]

      Thanks for the reply chromatic. I agree that isa() is a better way to validate object references.

      I am confused in regards to better ways to validate references however. What's a better way to validate an array ref than "if( 'ARRAY' eq ref $foo )"? Thanks!

[reply]

        What's a better way to validate an array ref than "if( 'ARRAY' eq ref $foo )"? Thanks!

        There are caveats whichever way you do it, but currently I tend to default to just derefing it within an eval block: 

        if (eval{ use strict 'refs'; @$foo; 1 }) {
  # it is, or pretends convincingly, to be an array ref
}

        [download]

        Caveat? Right. In the presence of ties or overloading, there may be side effects to derefing it. Pick your poison / buyer beware / etc.

        print "Just another Perl ${\(trickster and hacker)},"
        The Sidhekin proves Sidhe did it!

[reply]
[d/l]
[select]

        The problem I have with isa() is that I either need to use the verbose UNIVERSAL::isa( $foo, 'Object::Foo' ) syntax, or check the return of ref() to be sure that I can do $foo->isa('Object::Foo') without dying.

        Wrapping every isa() check in an eval{} seems cumbersome, too.

        After a bit of poking, Scalar::Util's  blessed() and reftype() look like pretty good options. I suppose I could just import isa(), as well.


        TGI says moo

[reply]
[d/l]
[select]

      Please expand on this observation or point to some resources that can shed some light on your reasoning?


      TGI says moo

[reply]

        ref gives you a class name. It's easy to fool; bless something into the wrong class name (or worse, a class name such as SCALAR. It's also easy to get wrong -- why do you have to know if something is a hash reference explicitly if the important thing is that you can dereference it as a hash (as in, it's a tied hash or has hash overloading)?

        ref ties you to a very specific representation of data, and it's extremely fragile. Fragile code breaks easily. It's a bad thing.

        With Scalar::Util's reftype() for the times when I really need to break encapsulation, I can't think of a good reason to keep ref in the language itself.

[reply]
[d/l]
[select]
Re: RFC: Perl meta programming
by bennymack (Pilgrim) on Oct 20, 2006 at 17:19 UTC

    Thanks for all the help everyone! Here are the revised attributes:

    sub {
    local *__ANON__='SomeTestPackage2::self_sub';
    my( $self, $none, $href, $aref, $non_empty_aref, $custom_aref ) = 
+@_;
    confess( 'SomeTestPackage2 $custom_aref must be a custom array ref
+' ) if not eval { scalar @$custom_aref; 1; };
    confess( 'SomeTestPackage2::self_sub $non_empty_aref needs a non-e
+mpty array reference' ) if not eval { scalar @$non_empty_aref; };
    confess( 'SomeTestPackage2::self_sub $aref needs an array referenc
+e' ) if not eval { scalar @$aref; 1; };
    confess( 'SomeTestPackage2::self_sub $href needs a hash reference'
+ ) if not eval { scalar %$href; 1; };
    confess( 'SomeTestPackage2::self_sub needs a SomeTestPackage2 refe
+rence' ) if not ref $self or not eval { $self->isa( 'SomeTestPackage2
+' ); };
    package SomeTestPackage2;
    use warnings;
    use strict 'refs';
    return ref $self, ref $href, ref $aref, scalar @{$non_empty_aref;}
+;
}

    [download]

    Now, back to the job of actually developing the meta programming interface. Thanks again.

[reply]
[d/l]

Back to Meditations