| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
4
|
|
|
4
|
|
30688
|
use strict; |
|
|
4
|
|
|
|
|
6
|
|
|
|
4
|
|
|
|
|
121
|
|
|
3
|
4
|
|
|
4
|
|
19
|
use warnings; |
|
|
4
|
|
|
|
|
6
|
|
|
|
4
|
|
|
|
|
189
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Mixin::ExtraFields::Driver; |
|
6
|
|
|
|
|
|
|
{ |
|
7
|
|
|
|
|
|
|
$Mixin::ExtraFields::Driver::VERSION = '0.140002'; |
|
8
|
|
|
|
|
|
|
} |
|
9
|
|
|
|
|
|
|
# ABSTRACT: a backend for extra field storage |
|
10
|
|
|
|
|
|
|
|
|
11
|
4
|
|
|
4
|
|
19
|
use Carp (); |
|
|
4
|
|
|
|
|
5
|
|
|
|
4
|
|
|
|
|
57
|
|
|
12
|
4
|
|
|
4
|
|
1027
|
use Sub::Install (); |
|
|
4
|
|
|
|
|
2441
|
|
|
|
4
|
|
|
|
|
318
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
BEGIN { |
|
16
|
4
|
|
|
4
|
|
11
|
for my $name (qw(from_args get_all_detailed_extra set_extra delete_extra)) { |
|
17
|
|
|
|
|
|
|
Sub::Install::install_sub({ |
|
18
|
|
|
|
|
|
|
as => $name, |
|
19
|
4
|
|
|
4
|
|
2143
|
code => sub { Carp::confess "method $name called but not implemented!" }, |
|
20
|
16
|
|
|
|
|
1646
|
}); |
|
21
|
|
|
|
|
|
|
} |
|
22
|
|
|
|
|
|
|
} |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub get_all_extra { |
|
26
|
2
|
|
|
2
|
1
|
6
|
my ($self, $object, $id) = @_; |
|
27
|
|
|
|
|
|
|
|
|
28
|
2
|
|
|
|
|
7
|
my %extra = $self->get_all_detailed_extra($object, $id); |
|
29
|
2
|
|
|
|
|
25
|
my @simple = map { $_ => $extra{$_}{value} } keys %extra; |
|
|
1
|
|
|
|
|
10
|
|
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub get_extra { |
|
34
|
3
|
|
|
3
|
1
|
8
|
my ($self, $object, $id, $name) = @_; |
|
35
|
|
|
|
|
|
|
|
|
36
|
3
|
|
|
|
|
13
|
my $extra = $self->get_detailed_extra($object, $id, $name); |
|
37
|
3
|
100
|
|
|
|
22
|
return $extra ? $extra->{value} : (); |
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub get_detailed_extra { |
|
41
|
4
|
|
|
4
|
1
|
9
|
my ($self, $object, $id, $name) = @_; |
|
42
|
|
|
|
|
|
|
|
|
43
|
4
|
|
|
|
|
14
|
my %extra = $self->get_all_detailed_extra($object, $id); |
|
44
|
4
|
100
|
|
|
|
63
|
return exists $extra{$name} ? $extra{$name} : (); |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub get_all_extra_names { |
|
49
|
3
|
|
|
3
|
1
|
10
|
my ($self, $object, $id) = @_; |
|
50
|
3
|
|
|
|
|
11
|
my %extra = $self->get_all_detailed_extra($object, $id); |
|
51
|
3
|
|
|
|
|
41
|
return keys %extra; |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub exists_extra { |
|
56
|
4
|
|
|
4
|
1
|
9
|
my ($self, $object, $id, $name) = @_; |
|
57
|
4
|
|
|
|
|
13
|
my %extra = $self->get_all_detailed_extra($object, $id); |
|
58
|
|
|
|
|
|
|
|
|
59
|
4
|
|
|
|
|
55
|
return exists $extra{ $name }; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub delete_all_extra { |
|
64
|
1
|
|
|
1
|
1
|
3
|
my ($self, $object, $id) = @_; |
|
65
|
|
|
|
|
|
|
|
|
66
|
1
|
|
|
|
|
5
|
for my $name ($self->get_all_extra_names($object, $id)) { |
|
67
|
1
|
|
|
|
|
6
|
$self->delete_extra($object, $id, $name); |
|
68
|
|
|
|
|
|
|
} |
|
69
|
|
|
|
|
|
|
} |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
1; |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
__END__ |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=pod |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=head1 NAME |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Mixin::ExtraFields::Driver - a backend for extra field storage |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head1 VERSION |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
version 0.140002 |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
This is really not something you'd use on your own, it's just used by |
|
88
|
|
|
|
|
|
|
Mixin::ExtraFields, but if you insist... |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
my $driver = Mixin::ExtraFields::Driver::Phlogiston->from_args(\%arg); |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
$driver->set($obj, $obj_id, flammable => "very!"); |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Mixin::ExtraFields::Driver is a base class for drivers used by |
|
97
|
|
|
|
|
|
|
Mixin::ExtraFields -- hence the name. A driver is expected to store and |
|
98
|
|
|
|
|
|
|
retrieve data keyed to an object and a name or key. It can store this in any |
|
99
|
|
|
|
|
|
|
way it likes, and does not need to guarantee persistence across processes. |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 SUBCLASSING |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
All drivers must implement the four methods listed below. The base class has |
|
104
|
|
|
|
|
|
|
implementations of these methods which will die noisily (C<confess>-ing) when |
|
105
|
|
|
|
|
|
|
called. |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Almost all methods are passed the same data as their first two arguments: |
|
108
|
|
|
|
|
|
|
C<$object>, the object for which the driver is to find or alter data, and |
|
109
|
|
|
|
|
|
|
C<$id>, that object's unique id. While this may be slighly redundant, it keeps |
|
110
|
|
|
|
|
|
|
the id-finding call in one place. |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 from_args |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
my $driver = Mixin::ExtraFields::Driver::Subclass->from_args(\%arg); |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
This method must return a driver object appropriate to the given args. It is |
|
117
|
|
|
|
|
|
|
not called C<new> because it need not return a new object for each call to it. |
|
118
|
|
|
|
|
|
|
Returning identical objects for identical configurations may be safe for some |
|
119
|
|
|
|
|
|
|
driver implementations, and it is expressly allowed. |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
The arguments passed to this method are those given as the C<driver> option to |
|
122
|
|
|
|
|
|
|
the C<fields> import group in Mixin::ExtraFields, less the C<class> option. |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 get_all_detailed_extra |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
my %extra = $driver->get_all_detailed_extra($object, $id); |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
This method must return all available information about all existing extra |
|
129
|
|
|
|
|
|
|
fields for the given object. It must be returned as a list of name/value |
|
130
|
|
|
|
|
|
|
pairs. The values must be references to hashes. Each hash must have an entry |
|
131
|
|
|
|
|
|
|
for the key C<value> giving the value for that name. |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head2 set_extra |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
$driver->set_extra($object, $id, $name, $value); |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
This method must set the named extra to the given value. |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 delete_extra |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
$driver->delete_extra($object, $id, $name); |
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
This method must delete the named extra, causing it to cease to exist. |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head1 OPTIMIZING |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
The methods below can all be implemented in terms of those above. If they are |
|
148
|
|
|
|
|
|
|
not provided by the subclass, basic implementations exist. These |
|
149
|
|
|
|
|
|
|
implementations may be less efficient than implementations crafted for the |
|
150
|
|
|
|
|
|
|
specifics of the storage engine behind the driver, so authors of driver |
|
151
|
|
|
|
|
|
|
subclasses should consider implementing these methods. |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head2 get_all_extra |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
my %extra = $driver->get_all_extra($object, $id); |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
This method behaves like C<get_all_detailed_extra>, above, but provides the |
|
158
|
|
|
|
|
|
|
entry's value, not a detailed hashref, as the value for each entry. |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 get_extra |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head2 get_detailed_extra |
|
163
|
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
my $value = $driver->get_extra($object, $id, $name); |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $hash = $driver->get_detailed_extra($object, $id, $name); |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
These methods return a single value requested by name, either as the value |
|
169
|
|
|
|
|
|
|
itself or a detailed hashref describing it. |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head2 get_all_extra_names |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
my @names = $driver->get_all_extra_names($object, $id); |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
This method returns the names of all existing extras for the given object. |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head2 exists_extra |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
if ($driver->exists_extra($object, $id, $name)) { ... } |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
This method returns true if an entry exists for the given name and false |
|
182
|
|
|
|
|
|
|
otherwise. |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head2 delete_all_extra |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
$driver->delete_all_extra($object, $id); |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
This method deletes all extras for the object, as per the C<delete_extra> |
|
189
|
|
|
|
|
|
|
method. |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head1 AUTHOR |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Ricardo Signes <rjbs@cpan.org> |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
196
|
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
This software is copyright (c) 2013 by Ricardo Signes. |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
|
200
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=cut |