package Autoload::Hash; require 5.5.0; our ($VERSION) = '0.1'; # -- Documentation --------------------------------------------------- +-------- =head1 NAME Autoload::Hash - Builds in AUTOLOAD functionality to objects =head1 SYNOPSIS package MyObject; use Autoload::Hash; our (%DEFAULTS) = ( 'param1' => 'value1', ... ); sub func1 { my $self = shift; $self->param2 = "Data"; # Scalar assignment $self->param3 = {'x1'=>'v1'}; # Hash reference $self->param4 = ['x1','y1']; # Array reference $self->func2(); return; }; package main; my ($object) = new MyObject(); $object->reference1 = "Data"; # C++-style assignment print $object->reference1,"\n"; =head1 DESCRIPTION C<Autoload> installs an AUTOLOAD sub in the current package space. It operates on HASH-type objects, which are certainly one of the more popular varieties. Additionally, a default C<new> constructor is installed, but this may be overridden as required. If the C<new> constructor is fine, but some additional configuration is required, this can be stored in an C<init> function. sub init { my ($self) = shift; $self->setting1 = "Setting 1 Data"; } Any data from the package C<%DEFAULTS> hash will be inserted into newly created objects. Additional parameters can be added in the C<new> call: my ($object) = new Object ('param1' => 'Param 1 Data'); The parameters supplied to C<new> will override any supplied in C<%DEFAULTS>. Calls to undefined values in the object will return 'C<undef>', which may cause warnings when using 'C<perl -w>', but this is to be expected +. Additionally, objects can reference other objects and their methods: $object->subobject = new OtherObject(); $object->subobject->reference = "Value"; $object->subobject->An_OtherObject_Method(); =head1 OPTIONS C<Autoload> can be instanced with a few different methods, any one of which can be selected depending on the usage requirements: use Autoload::Hash 'public'; This is the default method, whereby any function can read and write to the object's contents. use Autoload::Hash 'static'; This creates a static interface to the object properties, whereby noth +ing can be modified, even by the object on itself. use Autoload::Hash 'private'; This creates a private interface, whereby the object can modify itself by default, but others are prevented from making changes, and are redu +ced to a 'static' capacity (read-only). use Autoload::Hash qw(friends PackageA ObjectB &MethodC &PackageD: +:MethodE); This will allow read/write access to the object properties from the ob +ject itself, or any calls originaiting in C<PackageA::>, C<ObjectB::>, or f +rom sub C<&MethodC> in any package, or from the sub C<&MethodE> only from +the C<PackageD::> package. The C<friends> usage will create a C<%FRIENDS> hash in the calling package namespace where the access information is stored. This data should not be modified directly. =head1 LIMITATIONS When using C<friends>, note that the call to the object must originate within in one of the listed packages, and not in some manner that woul +d seem to go through one of them. Consider this code: package Objet; use AutoLoad::Hash; our (%DEFAULTS) = ( value_x => 1, value_y => 'z' ); package ObjetAmi; use Autoload::Hash qw( friends Objet ); package main; my ($object) = new Objet; $object->friend = new ObjetAmi; # OK $object->friend->x = "Something"; # Fails The assignment of "friend->x" fails since the call is originating outs +ide of the "Object" package, and from C<main::> instead, which is not list +ed as a friend. In a sense, the C<ObjectFriend> instance has no idea that + it is stored within a friendly C<Object>, as this information is not read +ily available. Instead, it understands the call originated in C<main::>, w +hich is not listed, and is therefore invalid (read-only). package MyObject; use Autoload::Hash; Presumably additional subroutines would be added after this code to build some functionality into this object. To develop a better understanding of Perl objects, visit some of the on-line reference materials, such as: Tom's Object-Oriented Tutorial for Perl http://www.perl.com/pub/doc/manual/html/pod/perltoot.html =head1 BUGS Autoload performs as expected on HASH-type objects, but may behave unexpectedly in other cases. Support for other techniques, such as ARRAY-type objects, may be added at a later point in time. =head1 AUTHOR Scott Tadman <tadman@elyrium.com> =cut # ' <- Syntax catcher ("Tom*s") # -- Imports --------------------------------------------------------- +-------- use Exporter; use strict qw (vars subs); use vars '$AUTOLOAD'; # -- Globals --------------------------------------------------------- +-------- my (%FRIENDS); # Stunt double (calling packages have their own) (ORPH +AN) our ($temp); # Throw-away value returned to callers my (@EXPORT) = qw( new ); # assert{}() will send a message to STDERR unless the code returns a t +rue value sub assert (&@) { my ($test) = shift; my (@callers); # If we pass, forget about it. return if (&$test); # Now complain about the calling caller (caller(1)) warn sprintf ("%s at %s line %d\n", join ('', @_), (caller(1)) +[1,2]); } # import() loads the package methods into the importing package namesp +ace sub import { my ($caller_package, $caller_file, $caller_line) = caller; my ($package) = shift; my ($symbol); @_ = ('public') unless (@_); $symbol = shift; if ($symbol =~ /^(public|static|private)$/) { *{"${caller_package}::AUTOLOAD"} = \&{"${package}::AUT +OLOAD_$symbol"}; assert { @_ } "Too many parameters in 'use' call"; } elsif ($symbol eq 'friends') { *{"${caller_package}::AUTOLOAD"} = \&{"${package}::AUT +OLOAD_friends"}; # At the very least, the object can make calls to itse +lf (default) local (*FRIENDS) = \%{"${caller_package}::FRIENDS"}; %FRIENDS = ('X::*' => { $caller_package => 'rw' }); my ($friend); foreach $friend (@_) { print "Adding friend $friend\n"; if ($friend =~ /^&/) { if ($friend =~ /::/) { $FRIENDS{'X::X'}{$friend} = 'r +w'; } } } else { $FRIENDS{'X::*'}{$friend} = 'rw'; } } my ($entry); foreach $entry (keys %FRIENDS) { print "$entry:\n"; foreach (keys %{$FRIENDS{$entry}}) { print "\t$_\n"; } } %{"${caller_package}::FRIENDS"} = %FRIENDS; } else { assert {} "Undefined import method '$symbol'"; } # Load in the standard EXPORTs my ($export); foreach $export (@EXPORT) { *{"${caller_package}::$export"} = \&{"$export"}; } } sub find_object_sub ($) { my ($package,$sub) = @_; if (*{"${package}::${package}::$sub"}{CODE}) { return \&{"${package}::${package}::$sub"}; } return; } # -- AUTOLOAD Arsenal ------------------------------------------------ +-------- sub AUTOLOAD_public : lvalue { my ($caller_package) = caller; my ($self) = shift; assert {ref ($self)} "Autoload.pm: Non-object reference to $AU +TOLOAD for package $c aller_package"; $AUTOLOAD =~ s/.*://; @_? $self->{$AUTOLOAD} = shift : !defined($self->{$AUTOLOAD})? $self->{$AUTOLOAD} = undef : $self->{$AUTOLOAD}; } sub AUTOLOAD_static { my ($caller_package) = caller; my ($self) = shift; assert {ref($self)} "Autoload.pm: Non-object reference to $AUT +OLOAD for package $ca ller_package"; $AUTOLOAD =~ s/.*://; assert {@_} "Invalid assignment to static property"; return $self->{$AUTOLOAD}; } sub AUTOLOAD_private : lvalue { my ($caller_package) = caller; my ($self) = shift; assert {ref($self)} "Autoload.pm: Non-object reference to $AUT +OLOAD for package $ca ller_package"; $AUTOLOAD =~ s/.*://; # Invalid object reference. (FUTURE: Fix) assert { ref ($self) } "Autoload.pm: Undefined subroutine $AUT +OLOAD"; (ref($self) eq $caller_package)? @_? $self->{$AUTOLOAD} = shift : !defined($self->{$AUTOLOAD})? $self->{$AUTOLOAD} = undef : $self->{$AUTOLOAD} : $temp = $self->{$AUTOLOAD}; } sub AUTOLOAD_friends : lvalue { my ($caller_package, $caller_file, $caller_line, $caller_func) + = caller(0); my ($self) = shift; assert {ref($self)} "Autoload.pm: Non-object reference to $AUT +OLOAD for package $ca ller_package"; my ($self_package) = ref($self); local (*FRIENDS) = \%{"${self_package}::FRIENDS"}; $AUTOLOAD =~ s/.*://; # Determine if this "friend" has access to these structures, o +r if a # temp should be returned as a decoy (to prevent any real dama +ge) ( ($FRIENDS{'X::*'} && $FRIENDS{'X::*'}{$caller_package} +) || ($FRIENDS{'*::X'} && $FRIENDS{'*::X'}{$caller_func}) + || ($FRIENDS{'X::X'} && $FRIENDS{'X::X'}{"$caller_package +\::$caller_func"}) )? @_ ? $self->{$AUTOLOAD} = shift : $self->{$AUTOLOAD} ||= un +def : $temp = $self-> {$AUTOLOAD}; } # -- Default Methods ------------------------------------------------- +-------- my (@SELF_STACK); sub new (%) { my ($this) = shift; my ($class) = ref ($this) || $this; # Assign (with optional defaults) as required my ($self) = (defined %{"${class}::DEFAULTS"})? { %{"${class}: +:DEFAULTS"}, @_ } : { @_ }; # Bless accordingly, to assign proper class bless ($self, $class); # Operate the init() function, if defined properly $self->init() if (*{"${class}::init"}{CODE}); # Return reference to the newly minted object return $self; } # -- Exit ------------------------------------------------------------ +-------- 1;
In reply to Autoload::Hash by tadman
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |