package pudu; use strict; use warnings; use constant Exportables => { has => { -as => 'has' }, new => { -as => 'new' } }; my @attrs = (); sub _exportTo { no strict qw[ refs ]; *{ $_[0] . '::' . $_[ 1 ] } = $_[ 2 ]; } sub new { my $class = shift; die "Uneven attribute list (Missing value?(use 'undef')" if @_ & 1; my %args = @_; return bless \@attrs, $class; } sub has { my $package = caller; my $name = shift; my %attr = @_; $attrs[ @attrs ] = \%attr; my $slot = eval qq[ sub(){ ${ \$#attrs } } ]; _exportTo( $package, $name, sub :lvalue { $_[ 0 ][ &$slot ]{ trigger }->( $_[ 0 ], $_[ 1 ] ) if $_[ 0 ][ &$slot ]{ trigger }; $_[ 0 ][ &$slot ] } ); } sub import { my $class = shift; die "Uneven parameter list (Symbol without alias?)" if @_ & 1; my %args = ( %{ +Exportables }, @_ ); my %exports; @exports{ keys %{ +Exportables } } = delete @args{ keys %{ +Exportables } }; warn "Unknown export(s) @{[ keys %args ]} ignored" if %args; my $package = caller; while( my( $export, $alias ) = each %exports ) { _exportTo( $package, $alias->{ -as }, \&$export ); } } 1;