Abstract-Meta-Class
view release on metacpan or search on metacpan
Changes
examples/example1.pl
lib/Abstract/Meta/Attribute.pm
lib/Abstract/Meta/Attribute/Method.pm
lib/Abstract/Meta/Class.pm
Makefile.PL
MANIFEST
META.yml Module meta-data (added by MakeMaker)
README
t/meta/array_storage/association.t
t/meta/array_storage/attribute.t
t/meta/array_storage/class.t
t/meta/association.t
t/meta/attribute.t
t/meta/class.t
t/meta/fix.t
t/pod.t
t/pod_coverage.t
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
Abstract::Meta::Attribute - Meta object attribute.
=head1 SYNOPSIS
use Abstract::Meta::Class ':all';
has '$.attr1' => (default => 0);
=head1 DESCRIPTION
An object that describes an attribute.
It includes required, data type, association validation, default value, lazy retrieval.
Name of attribute must begin with one of the follwoing prefix:
$. => Scalar,
@. => Array,
%. => Hash,
&. => Code,
=head1 EXPORT
None.
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
if($storage_type eq 'Array') {
my $meta_class= Abstract::Meta::Class::meta_class($args{class});
$attribute_index = $#{$meta_class->all_attributes} + 1;
}
my ($type, $accessor_name) = ($name =~ /^([\$\@\%\&])\.(.*)$/);
confess "invalid attribute defintion ${class}::" .($accessor_name || $name) .", supported prefixes are \$.,%.,\@.,&."
if ! $type || ! $supported_type{$type};
my %options;
$args{data_type_validation} = 1
if (! exists($args{data_type_validation})
&& ($type eq '@' || $type eq '%' || $args{associated_class}));
$options{'&.' . $_ } = $args{$_}
for grep {exists $args{$_}} (qw(on_read on_change on_validate));
my $storage_key = $storage_type eq 'Array' ? $attribute_index : $args{storage_key} || $args{name};
$options{'$.name'} = $accessor_name;
$options{'$.storage_key'} = $storage_key;
$options{'$.mutator'} = "set_$accessor_name";
$options{'$.accessor'} = $accessor_name;
$options{'$.' . $_ } = $args{$_}
for grep {exists $args{$_}}
(qw(class required default item_accessor associated_class data_type_validation index_by the_other_end transistent storage_type));
$options{'$.perl_type'} = $supported_type{$type};
unless ($args{default}) {
if($type eq '%') {
$options{'$.default'} = sub{ {} };
} elsif ($type eq '@') {
$options{'$.default'} = sub { [] };
}
}
%options;
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
=item the_other_end
Name of the asscessor/mutator on associated class to keep bideriectional association
This option will generate cleanup method.
=cut
sub the_other_end { shift()->{'$.the_other_end'} }
=item data_type_validation
Flag that turn on/off data type validation.
Data type validation happens when using association_class or Array or Hash data type
unless you explicitly disable it by seting data_type_validation => 0.
=cut
sub data_type_validation { shift()->{'$.data_type_validation'} }
=item on_read
Returns code reference that will be replace data read routine
has '%.attrs.' => (
item_accessor => 'attr'
on_read => sub {
my ($self, $attribute, $scope, $key) = @_;
my $values = $attribute->get_values($self);
if ($scope eq 'accessor') {
return $values;
} else {
return $values->{$key};
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
},
);
=cut
sub on_read { shift()->{'&.on_read'} }
=item set_on_read
Sets code reference that will be replace data read routine
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_read(sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
});
=cut
sub set_on_read {
my ($attr, $value) = @_;
$attr->{'&.on_read'} = $value;
my $meta= $attr->class->meta;
$meta->install_attribute_methods($attr, 1);
}
=item on_change
Code reference that will be executed when data is set,
Takes reference to the variable to be set.
=cut
sub on_change { shift()->{'&.on_change'} }
=item set_on_change
Sets code reference that will be executed when data is set,
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_change(sub {
my ($self, $attribute, $scope, $value, $key) = @_;
if($scope eq 'mutator') {
my $hash = $$value;
foreach my $k (keys %$hash) {
# do some stuff
#$self->validate_trigger($k, $hash->{$k});
}
lib/Abstract/Meta/Attribute.pm view on Meta::CPAN
$meta->install_attribute_methods($attr, 1);
}
=item on_validate
Returns on validate code reference.
It is executed before the data type validation happens.
=cut
sub on_validate { shift()->{'&.on_validate'} }
=item set_on_validate
Sets code reference that will be replace data read routine
my $attr = MyClass->meta->attribute('attrs');
$attr->set_on_read(sub {
my ($self, $attribute, $scope, $key) = @_;
#do some stuff
});
=cut
sub set_on_validate {
lib/Abstract/Meta/Attribute/Method.pm view on Meta::CPAN
my $attr = shift;
my $storage_key = $attr->storage_key;
my $transistent = $attr->transistent;
my $accessor = $attr->accessor;
my $required = $attr->required;
my $default = $attr->default;
my $associated_class = $attr->associated_class;
my $perl_type = $attr->perl_type;
my $index_by = $attr->index_by;
my $on_change = $attr->on_change;
my $data_type_validation = $attr->data_type_validation;
my $on_validate = $attr->on_validate;
my $array_storage_type = $attr->storage_type eq 'Array';
$array_storage_type ?
sub {
my ($self, $value) = @_;
if (! defined $value && defined $default) {
if (ref($default) eq 'CODE') {
$value = $default->($self, $attr);
} else {
$value = $default;
}
}
$on_validate->($self, $attr, 'mutator', \$value) if $on_validate;
if ($data_type_validation) {
$value = index_association_data($value, $accessor, $index_by)
if ($associated_class && $perl_type eq 'Hash');
$attr->validate_data_type($self, $value, $accessor, $associated_class, $perl_type);
if($required) {
if ($perl_type eq 'Hash') {
confess "attribute $accessor is required"
unless scalar %$value;
} elsif ($perl_type eq 'Array') {
confess "attribute $accessor is required"
unless scalar @$value;
}
}
lib/Abstract/Meta/Attribute/Method.pm view on Meta::CPAN
my ($self, $value) = @_;
if (! defined $value && defined $default) {
if (ref($default) eq 'CODE') {
$value = $default->($self, $attr);
} else {
$value = $default;
}
}
$on_validate->($self, $attr, 'mutator', \$value) if $on_validate;
if ($data_type_validation) {
$value = index_association_data($value, $accessor, $index_by)
if ($associated_class && $perl_type eq 'Hash');
$attr->validate_data_type($self, $value, $accessor, $associated_class, $perl_type);
if($required) {
if ($perl_type eq 'Hash') {
confess "attribute $accessor is required"
unless scalar %$value;
} elsif ($perl_type eq 'Array') {
confess "attribute $accessor is required"
unless scalar @$value;
}
}
lib/Abstract/Meta/Attribute/Method.pm view on Meta::CPAN
if ($transistent) {
set_attribute($self, $storage_key, $value);
} else {
$self->{$storage_key} = $value;
}
$self;
};
}
=item index_association_data
=cut
sub index_association_data {
my ($data, $attr_name, $index) = @_;
return $data if ref($data) eq 'HASH';
my %result;
if($index && $$data[0]->can($index)) {
%result = (map {($_->$index, $_)} @$data);
} else {
%result = (map {($_ . "", $_)} @$data);
}
\%result;
}
=item validate_data_type
=cut
sub validate_data_type {
my ($attr, $self, $value, $accessor, $associated_class, $perl_type) = @_;
my $array_storage_type = $attr->storage_type eq 'Array';
if ($perl_type eq 'Array') {
confess "$accessor must be $perl_type type"
unless (ref($value) eq 'ARRAY');
if ($associated_class) {
validate_associated_class($attr, $self, $_)
for @$value;
}
} elsif ($perl_type eq 'Hash') {
( run in 0.234 second using v1.01-cache-2.11-cpan-0d8aa00de5b )