package
AttributesWithHistory;
our
$VERSION
=
'0.05'
;
AttributesWithHistory->meta->add_attribute(
'history_accessor'
=> (
reader
=>
'history_accessor'
,
init_arg
=>
'history_accessor'
,
predicate
=>
'has_history_accessor'
,
));
AttributesWithHistory->meta->add_attribute(
'_history'
=> (
accessor
=>
'_history'
,
default
=>
sub
{ {} },
));
sub
accessor_metaclass {
'AttributesWithHistory::Method::Accessor'
}
AttributesWithHistory->meta->add_after_method_modifier(
'install_accessors'
=>
sub
{
my
(
$self
) =
@_
;
$self
->associated_class->add_method(
$self
->_process_accessors(
'history_accessor'
=>
$self
->history_accessor())
)
if
$self
->has_history_accessor();
});
package
AttributesWithHistory::Method::Accessor;
our
$VERSION
=
'0.01'
;
sub
_generate_history_accessor_method {
my
$attr_name
= (
shift
)->associated_attribute->name;
eval
qq{sub {
unless (ref \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}
) \{
\
$_
[0]->meta->get_attribute(
'$attr_name'
)->_history()->\{\
$_
[0]\} = [];
\}
\@\{\
$_
[0]->meta->get_attribute(
'$attr_name'
)->_history()->\{\
$_
[0]\}\};
}};
}
sub
_generate_accessor_method {
my
$attr_name
= (
shift
)->associated_attribute->name;
eval
qq{sub {
if (scalar(\@_) == 2) {
unless (ref \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}
) \{
\
$_
[0]->meta->get_attribute(
'$attr_name'
)->_history()->\{\
$_
[0]\} = [];
\}
push
\@\{\
$_
[0]->meta->get_attribute(
'$attr_name'
)->_history()->\{\
$_
[0]\}\} => \
$_
[1];
\
$_
[0]->{
'$attr_name'
} = \
$_
[1];
}
\
$_
[0]->{
'$attr_name'
};
}};
}
sub
_generate_writer_method {
my
$attr_name
= (
shift
)->associated_attribute->name;
eval
qq{sub {
unless (ref \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}
) \{
\
$_
[0]->meta->get_attribute(
'$attr_name'
)->_history()->\{\
$_
[0]\} = [];
\}
push
\@\{\
$_
[0]->meta->get_attribute(
'$attr_name'
)->_history()->\{\
$_
[0]\}\} => \
$_
[1];
\
$_
[0]->{
'$attr_name'
} = \
$_
[1];
}};
}
1;