view release on metacpan or  search on metacpan

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

    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


=head2 decorators

....- on_validate

    - on_change

    - on_read

    - initialise_method

    package Triggers;

    use Abstract::Meta::Class ':all';

    has '@.y' => (
        on_change => sub {
            my ($self, $attribute_name, $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, $attr_name, $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') {

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

    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);


=head2 external attributes storage

    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.


=head2 METHODS

=over

=item new

=cut

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    unshift @_, $self;
    &apply_contructor_parameters;
}


=item install_cleanup

Install cleanup method

=cut

sub install_cleanup {
    my ($self) = @_;
    my $attributes;
    return if $self->has_cleanup_method;
    add_method($self->associated_class, 'cleanup' , sub {
        my $this = shift;
        my $has_transistent;
        my $attributes ||= $self ? $self->all_attributes : [];
        for my $attribute (@$attributes) {
            $attribute or next;
            $has_transistent = 1 if($attribute->transistent);
            if($attribute->the_other_end) {
                $attribute->deassociate($this);
                my $accessor = "set_" . $attribute->accessor;
                $this->$accessor(undef);
            }
        }
        Abstract::Meta::Attribute::Method::delete_object($this) if $has_transistent;
    });
    $self->set_cleanup_method(1);
}


=item install_destructor

Install destructor method

=cut

sub install_destructor {
    my ($self) = @_;
    return if $self->has_destory_method;
    add_method($self->associated_class, 'DESTROY' , sub {
        my $this = shift;