File Coverage

blib/lib/OpenERP/OOM/Roles/Attribute.pm
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 8 8 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             OpenERP::OOM::Roles::Attribute - Meta attribute for implementing dirty attribute tracking
4              
5             =head1 DESCRIPTION
6              
7             This code was largely taken from a version of MooseX::TrackDirty before it
8             was updated to work with Moose 2.0. Then it was cut down to suit our purposes
9             being uses in the Moose::Exporter.
10              
11             =head1 LICENSE AND COPYRIGHT
12              
13             Copyright (C) 2011 OpusVL
14              
15             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
16              
17             =cut
18              
19             use namespace::autoclean;
20 2     2   541585 use Moose::Role;
  2         6694  
  2         14  
21 2     2   498  
  2         4348  
  2         8  
22             has track_dirty => (is => 'rw', isa => 'Bool', default => 1);
23             has dirty => (is => 'ro', isa => 'Str', predicate => 'has_dirty');
24              
25             has track_attribute_helpers_dirty =>
26             (is => 'rw', isa => 'Bool', default => 1);
27              
28              
29             # wrap our internal clearer
30             after clear_value => sub {
31             my ($self, $instance) = @_;
32              
33             $instance->_mark_clean($self->name) if $self->track_dirty;
34             };
35              
36             after install_accessors => sub {
37             my ($self, $inline) = @_;
38              
39             ### in install_accessors, installing if: $self->track_dirty
40             return unless $self->track_dirty;
41              
42             my $class = $self->associated_class;
43             my $name = $self->name;
44              
45             ### is_dirty: $self->dirty || ''
46             $class->add_method($self->dirty, sub { shift->_is_dirty($name) })
47             if $self->has_dirty;
48              
49             $class->add_after_method_modifier(
50             $self->clearer => sub { shift->_mark_clean($name) }
51             ) if $self->has_clearer;
52              
53             # if we're set, we're dirty (cach both writer/accessor)
54             $class->add_after_method_modifier(
55             $self->writer => sub { shift->_mark_dirty($name) }
56             ) if $self->has_writer;
57             $class->add_after_method_modifier(
58             $self->accessor =>
59             sub { $_[0]->_mark_dirty($name) if exists $_[1] }
60             ) if $self->has_accessor;
61              
62             return;
63             };
64              
65             before _process_options => sub {
66             my ($self, $name, $options) = @_;
67              
68             ### before _process_options: $name
69             $options->{dirty} = $name.'_is_dirty'
70             unless exists $options->{dirty} || !$options->{lazy_build};
71              
72             return;
73             };
74              
75             1;
76