view release on metacpan or  search on metacpan

lib/Class/Variable.pm  view on Meta::CPAN

use Carp;
use Scalar::Util 'weaken';

our $VERSION = '1.002'; # <== update version in pod

our @EXPORT;

my $NS = {};

push @EXPORT, 'public';
sub public($;)
{
    my @names = @_;
    my $package = (caller)[0];
    foreach my $name (@names)
    {
        no strict 'refs';
        *{$package.'::'.$name } = get_public_variable($package, $name);
    }
}

push @EXPORT, 'protected';
sub protected($;)
{
    my @names = @_;
    my $package = (caller)[0];
    foreach my $name (@names)
    {
        no strict 'refs';
        *{$package.'::'.$name } = get_protected_variable($package, $name);
    }
}

push @EXPORT, 'private';
sub private($;)
{
    my @names = @_;
    my $package = (caller)[0];
    foreach my $name (@names)
    {
        no strict 'refs';
        *{$package.'::'.$name } = get_private_variable($package, $name);
    }
}

sub get_public_variable($$)
{
    my( $package, $name ) = @_;
    
    return sub: lvalue
    {
        my $self = shift;
        if( 
            not exists $NS->{$self}
            or not defined $NS->{$self}->{' self'} 
        )

lib/Class/Variable.pm  view on Meta::CPAN

            $NS->{$self} = {
                ' self' => $self
            };
            weaken $NS->{$self}->{' self'};
        }
        
        $NS->{$self}->{$name};
    };
}

sub get_protected_variable($$)
{
    my( $package, $name ) = @_;
    
    return sub: lvalue
    {
        my $self = shift;
        if( 
            not exists $NS->{$self}
            or not defined $NS->{$self}->{' self'} 
        )

lib/Class/Variable.pm  view on Meta::CPAN

        croak sprintf(
            "Access violation: protected variable %s of %s available only to class or subclasses, but not %s."
            , $name || 'undefined'
            , $package || 'undefined'
            , caller()  || 'undefined' ) if not caller()->isa($package);
            
        $NS->{$self}->{$name};
    };
}

sub get_private_variable($$)
{
    my( $package, $name ) = @_;
    
    return sub: lvalue
    {
        my $self = shift;
        if( 
            not exists $NS->{$self}
            or not defined $NS->{$self}->{' self'} 
        )