view release on metacpan or  search on metacpan

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

package Class::Variable;
use 5.008;
use strict; use warnings FATAL => 'all'; 
use Exporter 'import';
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'} 
        )
        {
            $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'} 
        )
        {
            $NS->{$self} = {
                ' self' => $self
            };
            weaken $NS->{$self}->{' self'};
        }
        
        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'} 
        )
        {
            $NS->{$self} = {
                ' self' => $self
            };
            weaken $NS->{$self}->{' self'};
        }
        
        croak sprintf(
            "Access violation: private variable %s of %s available only to class itself, not %s."
            , $name || 'undefined'
            , $package || 'undefined'
            , caller()  || 'undefined' ) if caller() ne $package;
            
        $NS->{$self}->{$name};
    };
}


1;
__END__
=head1 NAME

Class::Variable - Perl implementation of class variables with access restrictions.

=head1 VERSION

Version 1.002

=head1 SYNOPSIS

This module allows You to create class members with access restrictions, using intuitive syntax:

    package Foo;
    use Class::Variable;
    
    public      'var1', 'var2';   # these variables available everywhere 
    protected   'var3', 'var4';   # these variables available only in objects of Foo class or subclasses
    private     'var5', 'var6';   # these variables available only in objects of Foo class 
    
meanwhile somewhere else ...
    
    use Foo;
    
    my $foo = Foo->new();
    
    $foo->var1 = "Public var content";      # works fine
    $foo->var3 = "Protected var content";   # croaks, protected
    $foo->var5 = "Private var content";     # croaks, private
    
All generated class variables are actually lvalue methods and can be inherited by subclasses.
    
=head1 DESCRIPTION

Module exports three methods, required to define variables: C<public>, C<protected> and C<private>.

Internally, there is a namespace variable in C<Class::Variable> package, which is not available from the outside and contains all data per object, using weak references to avoid duplicated references (not sure if it's possible). 

Generated class variables are lvalue subs with access control in them.

Don't forget, that data from generated variables is not encapsulated in object and can't be serialized.

=head1 BENCHMARKS

Here is a comparision of direct acces to hash elements and access to generated variables: