File Coverage

blib/lib/MooX/AliasedAttributes.pm

Criterion	Covered	Total	%
statement	25	25	100.0
branch	3	4	75.0
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	34	35	97.1

package MooX::AliasedAttributes;
$MooX::AliasedAttributes::VERSION = '0.03';
use strictures 1;

=head1 NAME

MooX::AliasedAttributes - Make aliases to your attributes, and methods.

=head1 SYNOPSIS

    package Foo;
    use Moo;
    use MooX::AliasedAttributes;

    has color => (
        is    => 'rw',
        alias => 'colour',
    );

    alias bar => 'color';

    my $foo = Foo->new( color=>'red' );

    print $foo->colour(); # red
    $foo->colour('green');
    print $foo->color(); # green

    print $foo->bar(); # green

=head1 DESCRIPTION

Aliases a method to an attribute's C.  Note that if you set either
C or C that this has no affect onthe alias, the alias
will still point at the attribute name.

This module came to life to help port L code using L
to L.  In order to port you existing code from L to L you
should just be able to replace C with
C.

=cut

use Class::Method::Modifiers qw( install_modifier );

sub import {
    my $target = caller();

    my $around = $target->can('around');
    my $fresh = sub{ install_modifier( $target, 'fresh', @_ ) };

    $fresh->(
        alias => sub{
            my ($aliases, $method) = @_;
            $aliases = [ $aliases ] if !ref $aliases;

            foreach my $alias ($aliases) {
                $fresh->( $alias => sub{ shift()->$method(@_) } );
            }
        },
    );

    my $alias = $target->can('alias');

    $around->(
        has => sub{
            my ($orig, $name, %attributes) = @_;

            my $aliases = delete $attributes{alias};
            $orig->( $name, %attributes );
            return if !$aliases;

            $alias->( $aliases, $name );

            return;
        },
    );

    return;
}

1;
__END__