]> git.koha-community.org Git - koha.git/blob - Koha/Objects.pm
Bug 18625: Update lastseen in patron info request
[koha.git] / Koha / Objects.pm
1 package Koha::Objects;
2
3 # Copyright ByWater Solutions 2014
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use Modern::Perl;
21
22 use Carp;
23 use List::MoreUtils qw( none );
24
25 use Koha::Database;
26
27 =head1 NAME
28
29 Koha::Objects - Koha Object set base class
30
31 =head1 SYNOPSIS
32
33     use Koha::Objects;
34     my @objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
35
36 =head1 DESCRIPTION
37
38 This class must be subclassed.
39
40 =head1 API
41
42 =head2 Class Methods
43
44 =cut
45
46 =head3 Koha::Objects->new();
47
48 my $object = Koha::Objects->new();
49
50 =cut
51
52 sub new {
53     my ($class) = @_;
54     my $self = {};
55
56     bless( $self, $class );
57 }
58
59 =head3 Koha::Objects->_new_from_dbic();
60
61 my $object = Koha::Objects->_new_from_dbic( $resultset );
62
63 =cut
64
65 sub _new_from_dbic {
66     my ( $class, $resultset ) = @_;
67     my $self = { _resultset => $resultset };
68
69     bless( $self, $class );
70 }
71
72 =head3 Koha::Objects->find();
73
74 Similar to DBIx::Class::ResultSet->find this method accepts:
75     \%columns_values | @pk_values, { key => $unique_constraint, %attrs }?
76 Strictly speaking, columns_values should only refer to columns under an
77 unique constraint.
78
79 my $object = Koha::Objects->find( { col1 => $val1, col2 => $val2 } );
80 my $object = Koha::Objects->find( $id );
81 my $object = Koha::Objects->find( $idpart1, $idpart2, $attrs ); # composite PK
82
83 =cut
84
85 sub find {
86     my ( $self, @pars ) = @_;
87
88     croak 'Cannot use "->find" in list context' if wantarray;
89
90     return if !@pars || none { defined($_) } @pars;
91
92     my $result = $self->_resultset()->find( @pars );
93
94     return unless $result;
95
96     my $object = $self->object_class()->_new_from_dbic( $result );
97
98     return $object;
99 }
100
101 =head3 Koha::Objects->find_or_create();
102
103 my $object = Koha::Objects->find_or_create( $attrs );
104
105 =cut
106
107 sub find_or_create {
108     my ( $self, $params ) = @_;
109
110     my $result = $self->_resultset->find_or_create($params);
111
112     return unless $result;
113
114     my $object = $self->object_class->_new_from_dbic($result);
115
116     return $object;
117 }
118
119 =head3 Koha::Objects->search();
120
121 my @objects = Koha::Objects->search($params);
122
123 =cut
124
125 sub search {
126     my ( $self, $params, $attributes ) = @_;
127
128     if (wantarray) {
129         my @dbic_rows = $self->_resultset()->search($params, $attributes);
130
131         return $self->_wrap(@dbic_rows);
132
133     }
134     else {
135         my $class = ref($self) ? ref($self) : $self;
136         my $rs = $self->_resultset()->search($params, $attributes);
137
138         return $class->_new_from_dbic($rs);
139     }
140 }
141
142 =head3 search_related
143
144     my @objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
145     my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
146
147 Searches the specified relationship, optionally specifying a condition and attributes for matching records.
148
149 =cut
150
151 sub search_related {
152     my ( $self, $rel_name, @params ) = @_;
153
154     return if !$rel_name;
155     if (wantarray) {
156         my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
157         return if !@dbic_rows;
158         my $object_class = _get_objects_class( $dbic_rows[0]->result_class );
159
160         eval "require $object_class";
161         return _wrap( $object_class, @dbic_rows );
162
163     } else {
164         my $rs = $self->_resultset()->search_related($rel_name, @params);
165         return if !$rs;
166         my $object_class = _get_objects_class( $rs->result_class );
167
168         eval "require $object_class";
169         return _new_from_dbic( $object_class, $rs );
170     }
171 }
172
173 =head3 single
174
175 my $object = Koha::Objects->search({}, { rows => 1 })->single
176
177 Returns one and only one object that is part of this set.
178 Returns undef if there are no objects found.
179
180 This is optimal as it will grab the first returned result without instantiating
181 a cursor.
182
183 See:
184 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod#Retrieve_one_and_only_one_row_from_a_resultset
185
186 =cut
187
188 sub single {
189     my ($self) = @_;
190
191     my $single = $self->_resultset()->single;
192     return unless $single;
193
194     return $self->object_class()->_new_from_dbic($single);
195 }
196
197 =head3 Koha::Objects->next();
198
199 my $object = Koha::Objects->next();
200
201 Returns the next object that is part of this set.
202 Returns undef if there are no more objects to return.
203
204 =cut
205
206 sub next {
207     my ( $self ) = @_;
208
209     my $result = $self->_resultset()->next();
210     return unless $result;
211
212     my $object = $self->object_class()->_new_from_dbic( $result );
213
214     return $object;
215 }
216
217 =head3 Koha::Objects->last;
218
219 my $object = Koha::Objects->last;
220
221 Returns the last object that is part of this set.
222 Returns undef if there are no object to return.
223
224 =cut
225
226 sub last {
227     my ( $self ) = @_;
228
229     my $count = $self->_resultset->count;
230     return unless $count;
231
232     my ( $result ) = $self->_resultset->slice($count - 1, $count - 1);
233
234     my $object = $self->object_class()->_new_from_dbic( $result );
235
236     return $object;
237 }
238
239
240
241 =head3 Koha::Objects->reset();
242
243 Koha::Objects->reset();
244
245 resets iteration so the next call to next() will start agein
246 with the first object in a set.
247
248 =cut
249
250 sub reset {
251     my ( $self ) = @_;
252
253     $self->_resultset()->reset();
254
255     return $self;
256 }
257
258 =head3 Koha::Objects->as_list();
259
260 Koha::Objects->as_list();
261
262 Returns an arrayref of the objects in this set.
263
264 =cut
265
266 sub as_list {
267     my ( $self ) = @_;
268
269     my @dbic_rows = $self->_resultset()->all();
270
271     my @objects = $self->_wrap(@dbic_rows);
272
273     return wantarray ? @objects : \@objects;
274 }
275
276 =head3 Koha::Objects->unblessed
277
278 Returns an unblessed representation of objects.
279
280 =cut
281
282 sub unblessed {
283     my ($self) = @_;
284
285     return [ map { $_->unblessed } $self->as_list ];
286 }
287
288 =head3 Koha::Objects->get_column
289
290 Return all the values of this set for a given column
291
292 =cut
293
294 sub get_column {
295     my ($self, $column_name) = @_;
296     return $self->_resultset->get_column( $column_name )->all;
297 }
298
299 =head3 Koha::Objects->TO_JSON
300
301 Returns an unblessed representation of objects, suitable for JSON output.
302
303 =cut
304
305 sub TO_JSON {
306     my ($self) = @_;
307
308     return [ map { $_->TO_JSON } $self->as_list ];
309 }
310
311 =head3 Koha::Objects->_wrap
312
313 wraps the DBIC object in a corresponding Koha object
314
315 =cut
316
317 sub _wrap {
318     my ( $self, @dbic_rows ) = @_;
319
320     my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
321
322     return @objects;
323 }
324
325 =head3 Koha::Objects->_resultset
326
327 Returns the internal resultset or creates it if undefined
328
329 =cut
330
331 sub _resultset {
332     my ($self) = @_;
333
334     if ( ref($self) ) {
335         $self->{_resultset} ||=
336           Koha::Database->new()->schema()->resultset( $self->_type() );
337
338         return $self->{_resultset};
339     }
340     else {
341         return Koha::Database->new()->schema()->resultset( $self->_type() );
342     }
343 }
344
345 sub _get_objects_class {
346     my ( $type ) = @_;
347     return unless $type;
348
349     if( $type->can('koha_objects_class') ) {
350         return $type->koha_objects_class;
351     }
352     $type =~ s|Schema::Result::||;
353     return "${type}s";
354 }
355
356 =head3 columns
357
358 my @columns = Koha::Objects->columns
359
360 Return the table columns
361
362 =cut
363
364 sub columns {
365     my ( $class ) = @_;
366     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
367 }
368
369 =head3 AUTOLOAD
370
371 The autoload method is used call DBIx::Class method on a resultset.
372
373 Important: If you plan to use one of the DBIx::Class methods you must provide
374 relevant tests in t/db_dependent/Koha/Objects.t
375 Currently count, pager, update and delete are covered.
376
377 =cut
378
379 sub AUTOLOAD {
380     my ( $self, @params ) = @_;
381
382     my @known_methods = qw( count is_paged pager update delete result_class single slice );
383     my $method = our $AUTOLOAD;
384     $method =~ s/.*:://;
385
386     carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
387     my $r = eval { $self->_resultset->$method(@params) };
388     if ( $@ ) {
389         carp "No method $method found for " . ref($self) . " " . $@;
390         return
391     }
392     return $r;
393 }
394
395 =head3 _type
396
397 The _type method must be set for all child classes.
398 The value returned by it should be the DBIC resultset name.
399 For example, for holds, _type should return 'Reserve'.
400
401 =cut
402
403 sub _type { }
404
405 =head3 object_class
406
407 This method must be set for all child classes.
408 The value returned by it should be the name of the Koha
409 object class that is returned by this class.
410 For example, for holds, object_class should return 'Koha::Hold'.
411
412 =cut
413
414 sub object_class { }
415
416 sub DESTROY { }
417
418 =head1 AUTHOR
419
420 Kyle M Hall <kyle@bywatersolutions.com>
421
422 =cut
423
424 1;