Abstract::Meta::Class - Simple meta object protocol implementation.
package Dummy;
use Abstract::Meta::Class ':all';
has '$.attr1' => (default => 0);
has '%.attrs2' => (default => {a => 1, b => 3}, item_accessor => 'attr2');
has '@.atts3' => (default => [1, 2, 3], required => 1, item_accessor => 'attr3');
has '&.att3' => (required => 1);
has '$.att4' => (default => sub { 'stuff' } , required => 1);
my $dummt = Dummy->new(
att3 => 3,
);
use Dummy;
my $obj = Dummy->new(attr3 => sub {});
my $attr1 = $obj->attr1; #0
$obj->set_attr1(1);
$obj->attr2('c', 4);
$obj->attrs2 #{a => 1, b => 3. c => 4};
my $val_a = $obj->attr2('a');
my $item_1 = $obj->attr3(1);
$obj->count_attrs3();
$obj->push_attrs3(4);
Meta object protocol implementation,
To speed up bless time as well optimise memory usage you can use Array storage type. (Hash is the default storage type)
package Dummy;
use Abstract::Meta::Class ':all';
storage_type 'Array';
has '$.attr1' => (default => 0);
has '%.attrs2' => (default => {a => 1, b => 3}, item_accessor => 'attr2');
has '@.attrs3' => (default => [1, 2, 3], required => 1, item_accessor => 'attr3');
has '&.attr4' => (required => 1);
has '$.attr5';
has '$.attr6' => (default => sub { 'stuff' } , required => 1);
my $dummy = Dummy->new(
attr4 => sub {},
);
use Data::Dumper;
warn Dumper $dummy;
# bless [0, {a =>1,b => 3}, [1,2,3],sub{},undef,sub {}], 'Dummy'
package Dummy;
use Abstract::Meta::Class ':all';
has '$.attr1' => (default => 0);
has '&.att3' => (required => 1);
use Dummy;
my $obj = Dummy->new; #dies - att3 required
While specyfing array type of attribute
the following methods are added (count || push || pop || shift || unshift)_accessor.
package Dummy;
use Abstract::Meta::Class ':all';
has '@.array' => (item_accessor => 'array_item');
use Dummy;
my $obj = Dummy->new;
$obj->count_array();
$obj->push_array(1);
my $x = $obj->array_item(0);
my $y = $obj->pop_array;
#NOTE scalar, array context sensitive
my $array_ref = $obj->array;
my @array = $obj->array;
While specyfing an array or a hash type of attribute then
you may specify item_accessor for get/set value by hash key or array index.
package Dummy;
use Abstract::Meta::Class ':all';
has '%.hash' => (item_accessor => 'hash_item');
use Dummy;
my $obj = Dummy->new;
$obj->hash_item('key1', 'val1');
$obj->hash_item('key2', 'val2');
my $val = $obj->hash_item('key1');
#NOTE scalar, array context sensitive
my $hash_ref = $obj->hash;
my %hash = $obj->hash;
Dy default all complex types are validated against its definition.
package Dummy;
use Abstract::Meta::Class ':all';
has '%.hash' => (item_accessor => 'hash_item');
has '@.array' => (item_accessor => 'array_item');
use Dummy;
my $obj = Dummy->new(array => {}, hash => []) #dies incompatible types.
This module handles different types of associations(to one, to many, to many ordered).
You may also use bidirectional association by using the_other_end option,
NOTE: When using the_other_end automatic association/deassociation happens,
celanup method is installed.
package Class;
use Abstract::Meta::Class ':all';
has '$.to_one' => (associated_class => 'AssociatedClass');
has '@.ordered' => (associated_class => 'AssociatedClass');
has '%.to_many' => (associated_class => 'AssociatedClass', item_accessor => 'many', index_by => 'id');
use Class;
use AssociatedClass;
my $obj1 = Class->new(to_one => AssociatedClass->new);
my $obj2 = Class->new(ordered => [AssociatedClass->new]);
# NOTE: context sensitive (scalar, array)
my @association_objs = $obj2->ordered;
my @array_ref = $obj2->ordered;
my $obj3 = Class->new(to_many => [AssociatedClass->new(id =>'001'), AssociatedClass->new(id =>'002')]);
my $association_obj = $obj3->many('002);
# NOTE: context sensitive (scalar, array)
my @association_objs = values %{$obj3->to_many};
my $hash_ref = $obj3->to_many;
- bidirectional associations (the_other_end attribute)
package Master;
use Abstract::Meta::Class ':all';
has '$.name';
has '%.details' => (associated_class => 'Detail', the_other_end => 'master', item_accessor => 'detail', index_by => 'id');
package Detail;
use Abstract::Meta::Class ':all';
has '$.id' => (required => 1);
has '$.master' => (
associated_class => 'Master',
the_other_end => 'details'
);
use Master;
use Detail;
my @details = (
Detail->new(id => 1),
Detail->new(id => 2),
Detail->new(id => 3),
);
my $master = Master->new(name => 'foo', details => [@details]);
print $details[0]->master->name;
- while using an array/hash association storage remove_<attribute_name> | add_<attribute_name> are added.
$master->add_details(Detail->new(id => 4),);
$master->remove_details($details[0]);
#cleanup method is added to class, that deassociates all bidirectional associations
- on_validate
- on_change
- on_read
- initialise_method
package Triggers;
use Abstract::Meta::Class ':all';
has '@.y' => (
on_change => sub {
my ($self, $attribute, $scope, $value_ref, $index) = @_;
# scope -> mutator, item_accessor
... do some stuff
# process further in standard way by returning true
$self;
},
# replaces standard read
on_read => sub {
my ($self, $attribute, $scope, $index)
#scope can be: item_accessor, accessor
...
#return requested value
},
item_accessor => 'y_item'
);
use Triggers;
my $obj = Triggers->new(y => [1,2,3]);
- add hoc decorators
package Class;
use Abstract::Meta::Class ':all';
has '%.attrs' => (item_accessor => 'attr');
my $attr = DynamicInterceptor->meta->attribute('attrs');
my $obj = DynamicInterceptor->new(attrs => {a => 1, b => 2});
my $a = $obj->attr('a');
my %hook_access_log;
my $ncode_ref = sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
# or
if ($scope eq 'accessor') {
return $values;
} else {
return $values->{$key};
}
};
$attr->set_on_read($ncode_ref);
# from now it will apply to Class::attrs calls.
my $a = $obj->attr('a');
package BaseClass;
use Abstract::Meta::Class ':all';
has '$.attr1';
abstract => 'method1';
package Class;
use base 'BaseClass';
sub method1 {};
use Class;
my $obj = BaseClass->new;
# abstract classes
package InterfaceA;
use Abstract::Meta::Class ':all';
abstract_class;
abstract => 'method1';
abstract => 'method2';
package ClassA;
use base 'InterfaceA';
sub method1 {};
sub method2 {};
use Class;
my $classA = Class->new;
package Class;
use Abstract::Meta::Class ':all';
has 'attr1';
has 'interface_attr' => (associated_class => 'InterfaceA', required => 1);
use Class;
my $obj = Class->new(interface_attr => $classA);
You may want store attributes values outside the blessed reference, then you may
use transistent keyword (Inside Out Objects)
package Transistent;
use Abstract::Meta::Class ':all';
has '$.attr1';
has '$.x' => (required => 1);
has '$.t' => (transistent => 1);
has '%.th' => (transistent => 1);
has '@.ta' => (transistent => 1);
use Transistent;
my $obj = Transistent->new(attr1 => 1, x => 2, t => 3, th => {a =>1}, ta => [1,2,3]);
use Data::Dumper;
print Dumper $obj;
Cleanup and DESTORY methods are added to class, that delete externally stored attributes.
Install cleanup method
Install destructor method
Install constructor
Applies constructor parameters.
Returns attributes for meta class
Mutator sets attributes for the meta class
Returns true if cleanup method was generated
Sets clean up
Returns true is destroy method was generated
Sets set_destructor flag.
Returns initialise method's name default is 'initialise'
Returns is class is an abstract class.
Set an abstract class flag.
Mutator sets initialise_method for the meta class
Returns associated class name
Mutator sets associated class name
Returns all_attributes for all inherited meta classes
Returns attribute object
Adds class to meta repository.
Returns meta class object for passed in class name.
Returns meta attribute class
Creates a meta attribute.
Takes attribute name, and the following attribute options: see also Abstract::Meta::Attribute
Sets storage type for the attributes, optionally constructor code ref allowed values are Array/Hash, \
Creates an abstract method
Creates an abstract method
Installs attribute methods.
Adds code reference to the class symbol table. Takes a class name, method name and CODE reference.
Adds code reference to the class symbol table. Takes a class name, method name and CODE reference.
Returns a list of attributes that need be validated and all that have default value
The Abstract::Meta::Class module is free software. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file.
Adrian Witas, adrian@webapp.strefa.pl
