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 |