view release on metacpan or  search on metacpan

lib/Attribute/Method.pm  view on Meta::CPAN

package Attribute::Method;

use warnings;
use strict;
use Attribute::Handlers;
use B::Deparse;

our $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)/g;

my $dp        = Attribute::Method::_Deparse->new('-l');
my $dppack;
my %sigil2ref = (
    '$' => \undef,
    '@' => [],
    '%' => {},
);

sub import {
    my ( $class, @vars ) = @_;
    my $pkg = caller();
    push @vars, '$self';
    for my $var (@vars) {
        my $sigil = substr( $var, 0, 1, '' );
        no strict 'refs';
        *{ $pkg . '::' . $var } = $sigil2ref{$sigil};
    }
}

sub UNIVERSAL::Method : ATTR(RAWDATA) {
    my ( $pkg, $sym, $ref, undef, $args ) = @_;
    $dppack = $pkg;
    my $src = $dp->coderef2text($ref);
    if ($args) {
        $src =~ s/\{/{\nmy \$self = shift; my ($args) = \@_;\n/;
    }
    else {
        $src =~ s/\{/{\nmy \$self = shift;\n/;
    }
    no warnings 'redefine';
    my $sub_name = *{$sym}{NAME};
    eval qq{ package $pkg; sub $sub_name $src };
}

package
 Attribute::Method::_Deparse;

BEGIN { our @ISA = 'B::Deparse' }

sub maybe_qualify {
    my $ret = SUPER::maybe_qualify{@_};
    my ($pack,$name) = $ret =~ /(.*)::(.+)/;
    length $pack && $pack eq $dppack and return $name;
    $ret;
}

"Rosebud"; # for MARCEL's sake, not 1 -- dankogai

__END__

=head1 NAME

Attribute::Method - No more 'my $self = shift;'

=head1 SYNOPSIS

  package Lazy;
  use strict;
  use warnings;
  use Attribute::Method qw( $val );
	                # pass all parameter names here
                        # to make strict.pm happy
  sub new : Method { 
      bless { @_ }, $self 
  }
  sub set_foo : Method( $val ){
      $self->{foo} = $val;
  }
  sub get_foo : Method {
      $self->{foo};
  }