line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Elive::DAO::_Base; |
2
|
36
|
|
|
36
|
|
12084
|
use warnings; use strict; |
|
36
|
|
|
36
|
|
62
|
|
|
36
|
|
|
|
|
999
|
|
|
36
|
|
|
|
|
150
|
|
|
36
|
|
|
|
|
50
|
|
|
36
|
|
|
|
|
991
|
|
3
|
|
|
|
|
|
|
|
4
|
36
|
|
|
36
|
|
157
|
use parent qw{Class::Data::Inheritable}; |
|
36
|
|
|
|
|
139
|
|
|
36
|
|
|
|
|
222
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
Elive::DAO::_Base - Base class for DAO objects |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=cut |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $DEBUG; |
13
|
|
|
|
|
|
|
BEGIN { |
14
|
36
|
|
|
36
|
|
10026
|
$DEBUG = $ENV{ELIVE_DEBUG}; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub debug { |
18
|
379
|
|
|
379
|
0
|
358
|
my ($class, $level) = @_; |
19
|
|
|
|
|
|
|
|
20
|
379
|
50
|
|
|
|
614
|
if (defined $level) { |
21
|
0
|
|
|
|
|
0
|
$DEBUG = $level; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
379
|
|
50
|
|
|
2071
|
return $DEBUG || 0; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub _refaddr { |
28
|
636
|
|
|
636
|
|
488
|
my $self = shift; |
29
|
636
|
|
|
|
|
1369
|
return Scalar::Util::refaddr( $self ); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our %Meta_Data; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# |
35
|
|
|
|
|
|
|
# create metadata properties. NB this will be stored inside out to |
36
|
|
|
|
|
|
|
# ensure our object is an exact image of the data. |
37
|
|
|
|
|
|
|
# |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head2 has_metadata |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Associate an inside-out property with objects of a given class. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=cut |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub has_metadata { |
46
|
|
|
|
|
|
|
|
47
|
151
|
|
|
151
|
1
|
219
|
my $class = shift; |
48
|
151
|
|
|
|
|
191
|
my $accessor = shift; |
49
|
|
|
|
|
|
|
|
50
|
151
|
|
|
|
|
569
|
my $accessor_fun = $class->can($accessor); |
51
|
|
|
|
|
|
|
|
52
|
151
|
50
|
|
|
|
367
|
unless ($accessor_fun) { |
53
|
|
|
|
|
|
|
|
54
|
36
|
|
|
36
|
|
184
|
no strict 'refs'; |
|
36
|
|
|
|
|
53
|
|
|
36
|
|
|
|
|
6751
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
$accessor_fun = sub { |
57
|
318
|
|
|
318
|
|
266
|
my $self = shift; |
58
|
318
|
50
|
|
|
|
467
|
my $ref = $self->_refaddr |
59
|
|
|
|
|
|
|
or return; |
60
|
|
|
|
|
|
|
|
61
|
318
|
50
|
|
|
|
506
|
if (@_) { |
62
|
0
|
|
|
|
|
0
|
$Meta_Data{ $ref }{ $accessor } = $_[0]; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
318
|
|
|
|
|
1487
|
return $Meta_Data{ $ref }{ $accessor }; |
66
|
151
|
|
|
|
|
510
|
}; |
67
|
|
|
|
|
|
|
|
68
|
151
|
|
|
|
|
177
|
*{$class.'::'.$accessor} = $accessor_fun; |
|
151
|
|
|
|
|
423
|
|
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
151
|
|
|
|
|
319
|
return $accessor_fun; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
__PACKAGE__->mk_classdata('_connection'); |
75
|
|
|
|
|
|
|
__PACKAGE__->has_metadata('_object_connection'); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub connection { |
78
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
79
|
1
|
|
|
|
|
1
|
my $connection; |
80
|
1
|
50
|
|
|
|
5
|
$connection = $self->_object_connection(@_) |
81
|
|
|
|
|
|
|
if ref $self; |
82
|
1
|
|
33
|
|
|
11
|
$connection ||= $self->_connection(@_); |
83
|
1
|
|
|
|
|
13
|
return $connection; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub DEMOLISH { |
87
|
318
|
|
|
318
|
0
|
265
|
my $self = shift; |
88
|
318
|
|
|
|
|
394
|
delete $Meta_Data{ $self->_refaddr }; |
89
|
318
|
|
|
|
|
1218
|
return; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
1; |