3 # Copyright ByWater Solutions 2014
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use List::MoreUtils qw( none );
27 use Koha::Exceptions::Object;
31 Koha::Objects - Koha Object set base class
36 my $objects = Koha::Objects->search({ borrowernumber => $borrowernumber});
40 This class must be subclassed.
48 =head3 Koha::Objects->new();
50 my $object = Koha::Objects->new();
58 bless( $self, $class );
61 =head3 Koha::Objects->_new_from_dbic();
63 my $object = Koha::Objects->_new_from_dbic( $resultset );
68 my ( $class, $resultset ) = @_;
69 my $self = { _resultset => $resultset };
71 bless( $self, $class );
74 =head3 Koha::Objects->find();
76 Similar to DBIx::Class::ResultSet->find this method accepts:
77 \%columns_values | @pk_values, { key => $unique_constraint, %attrs }?
78 Strictly speaking, columns_values should only refer to columns under an
81 It returns undef if no results were found
83 my $object = Koha::Objects->find( { col1 => $val1, col2 => $val2 } );
84 my $object = Koha::Objects->find( $id );
85 my $object = Koha::Objects->find( $idpart1, $idpart2, $attrs ); # composite PK
90 my ( $self, @pars ) = @_;
94 unless (!@pars || none { defined($_) } @pars) {
95 my $result = $self->_resultset()->find(@pars);
97 $object = $self->object_class()->_new_from_dbic($result);
104 =head3 Koha::Objects->find_or_create();
106 my $object = Koha::Objects->find_or_create( $attrs );
111 my ( $self, $params ) = @_;
113 my $result = $self->_resultset->find_or_create($params);
115 return unless $result;
117 my $object = $self->object_class->_new_from_dbic($result);
125 my $objects = Koha::Objects->search([$params, $attributes]);
126 while (my $object = $objects->next) {
130 This B<instantiates> the I<Koha::Objects> class, and generates a resultset
131 based on the query I<$params> and I<$attributes> that are passed (like in DBIC).
136 my ( $self, $params, $attributes ) = @_;
138 my $class = ref($self) ? ref($self) : $self;
139 my $rs = $self->_resultset()->search($params, $attributes);
141 return $class->_new_from_dbic($rs);
144 =head3 search_related
146 my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
148 Searches the specified relationship, optionally specifying a condition and attributes for matching records.
153 my ( $self, $rel_name, @params ) = @_;
155 return if !$rel_name;
157 my $rs = $self->_resultset()->search_related($rel_name, @params);
159 my $object_class = _get_objects_class( $rs->result_class );
161 eval "require $object_class";
162 return _new_from_dbic( $object_class, $rs );
172 if ( Class::Inspector->function_exists( $self->object_class, 'delete' ) ) {
174 $self->_resultset->result_source->schema->txn_do( sub {
175 $self->reset; # If we iterated already over the set
176 while ( my $o = $self->next ) {
181 return $objects_deleted;
184 return $self->_resultset->delete;
189 my $objects = Koha::Objects->new; # or Koha::Objects->search
190 $objects->update( $fields, [ { no_triggers => 0/1 } ] );
192 This method overloads the DBIC inherited one so if code-level triggers exist
193 (through the use of an overloaded I<update> or I<store> method in the Koha::Object
194 based class) those are called in a loop on the resultset.
196 If B<no_triggers> is passed and I<true>, then the DBIC update method is called
197 directly. This feature is important for performance, in cases where no code-level
198 triggers should be triggered. The developer will explicitly ask for this and QA should
199 catch wrong uses as well.
204 my ($self, $fields, $options) = @_;
206 Koha::Exceptions::Object::NotInstantiated->throw(
211 my $no_triggers = $options->{no_triggers};
215 && ( Class::Inspector->function_exists( $self->object_class, 'update' )
216 or Class::Inspector->function_exists( $self->object_class, 'store' ) )
220 $self->_resultset->result_source->schema->txn_do( sub {
221 while ( my $o = $self->next ) {
226 return $objects_updated;
229 return $self->_resultset->update($fields);
232 =head3 filter_by_last_update
234 my $filtered_objects = $objects->filter_by_last_update({
235 from => $from_datetime, to => $to_datetime,
236 days|older_than => $days, min_days => $days, younger_than => $days,
239 You should pass at least one of the parameters: from, to, days|older_than,
240 min_days or younger_than. Make sure that they do not conflict with each other
241 to get meaningful results.
242 Note: from, to and min_days are inclusive! And by nature days|older_than
243 and younger_than are exclusive.
245 The from and to parameters must be DateTime objects.
249 sub filter_by_last_update {
250 my ( $self, $params ) = @_;
251 my $timestamp_column_name = $params->{timestamp_column_name} || 'timestamp';
253 Koha::Exceptions::MissingParameter->throw("Please pass: days|from|to|older_than|younger_than")
254 unless grep { exists $params->{$_} } qw/days from to older_than younger_than min_days/;
256 foreach my $key (qw(from to)) {
257 if (exists $params->{$key} and ref $params->{$key} ne 'DateTime') {
258 Koha::Exceptions::WrongParameter->throw("'$key' parameter must be a DateTime object");
262 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
263 foreach my $p ( qw/days older_than younger_than min_days/ ) {
264 next if !exists $params->{$p};
265 my $days = $params->{$p};
266 my $operator = { days => '<', older_than => '<', min_days => '<=' }->{$p} // '>';
267 $conditions->{$operator} = \['DATE_SUB(CURDATE(), INTERVAL ? DAY)', $days];
269 if ( exists $params->{from} ) {
270 $conditions->{'>='} = $dtf->format_datetime( $params->{from} );
272 if ( exists $params->{to} ) {
273 $conditions->{'<='} = $dtf->format_datetime( $params->{to} );
276 return $self->search(
278 $timestamp_column_name => $conditions
285 my $object = Koha::Objects->search({}, { rows => 1 })->single
287 Returns one and only one object that is part of this set.
288 Returns undef if there are no objects found.
290 This is optimal as it will grab the first returned result without instantiating
294 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod#Retrieve_one_and_only_one_row_from_a_resultset
301 my $single = $self->_resultset()->single;
302 return unless $single;
304 return $self->object_class()->_new_from_dbic($single);
307 =head3 Koha::Objects->next();
309 my $object = Koha::Objects->next();
311 Returns the next object that is part of this set.
312 Returns undef if there are no more objects to return.
319 my $result = $self->_resultset()->next();
320 return unless $result;
322 my $object = $self->object_class()->_new_from_dbic( $result );
327 =head3 Koha::Objects->last;
329 my $object = Koha::Objects->last;
331 Returns the last object that is part of this set.
332 Returns undef if there are no object to return.
339 my $count = $self->_resultset->count;
340 return unless $count;
342 my ( $result ) = $self->_resultset->slice($count - 1, $count - 1);
344 my $object = $self->object_class()->_new_from_dbic( $result );
351 my $empty_rs = Koha::Objects->new->empty;
353 Sets the resultset empty. This is handy for consistency on method returns
354 (e.g. if we know in advance we won't have results but want to keep returning
362 Koha::Exceptions::Object::NotInstantiated->throw(
367 $self = $self->search(\'0 = 1');
368 $self->_resultset()->set_cache([]);
373 =head3 Koha::Objects->reset();
375 Koha::Objects->reset();
377 resets iteration so the next call to next() will start agein
378 with the first object in a set.
385 $self->_resultset()->reset();
390 =head3 Koha::Objects->as_list();
392 Koha::Objects->as_list();
394 Returns an arrayref of the objects in this set.
401 my @dbic_rows = $self->_resultset()->all();
403 my @objects = $self->_wrap(@dbic_rows);
405 return wantarray ? @objects : \@objects;
408 =head3 Koha::Objects->unblessed
410 Returns an unblessed representation of objects.
417 return [ map { $_->unblessed } $self->as_list ];
420 =head3 Koha::Objects->get_column
422 Return all the values of this set for a given column
427 my ($self, $column_name) = @_;
428 return $self->_resultset->get_column( $column_name )->all;
431 =head3 Koha::Objects->TO_JSON
433 Returns an unblessed representation of objects, suitable for JSON output.
440 return [ map { $_->TO_JSON } $self->as_list ];
443 =head3 Koha::Objects->to_api
445 Returns a representation of the objects, suitable for API output .
450 my ($self, $params) = @_;
452 return [ map { $_->to_api($params) } $self->as_list ];
455 =head3 attributes_from_api
457 my $attributes = $objects->attributes_from_api( $api_attributes );
459 Translates attributes from the API to DBIC
463 sub attributes_from_api {
464 my ( $self, $attributes ) = @_;
466 $self->{_singular_object} ||= $self->object_class->new();
467 return $self->{_singular_object}->attributes_from_api( $attributes );
470 =head3 from_api_mapping
472 my $mapped_attributes_hash = $objects->from_api_mapping;
474 Attributes map from the API to DBIC
478 sub from_api_mapping {
481 $self->{_singular_object} ||= $self->object_class->new();
482 return $self->{_singular_object}->from_api_mapping;
485 =head3 prefetch_whitelist
487 my $whitelist = $object->prefetch_whitelist()
489 Returns a hash of prefetchable subs and the type it returns
493 sub prefetch_whitelist {
496 $self->{_singular_object} ||= $self->object_class->new();
498 $self->{_singular_object}->prefetch_whitelist;
501 =head3 Koha::Objects->_wrap
503 wraps the DBIC object in a corresponding Koha object
508 my ( $self, @dbic_rows ) = @_;
510 my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
515 =head3 Koha::Objects->_resultset
517 Returns the internal resultset or creates it if undefined
525 $self->{_resultset} ||=
526 Koha::Database->new()->schema()->resultset( $self->_type() );
528 return $self->{_resultset};
531 return Koha::Database->new()->schema()->resultset( $self->_type() );
535 sub _get_objects_class {
539 if( $type->can('koha_objects_class') ) {
540 return $type->koha_objects_class;
542 $type =~ s|Schema::Result::||;
548 my @columns = Koha::Objects->columns
550 Return the table columns
556 return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
561 The autoload method is used call DBIx::Class method on a resultset.
563 Important: If you plan to use one of the DBIx::Class methods you must provide
564 relevant tests in t/db_dependent/Koha/Objects.t
565 Currently count, is_paged, pager, result_class, single and slice are covered.
570 my ( $self, @params ) = @_;
572 my @known_methods = qw( count is_paged pager result_class single slice );
573 my $method = our $AUTOLOAD;
577 unless ( grep { $_ eq $method } @known_methods ) {
578 my $class = ref($self) ? ref($self) : $self;
579 Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
580 error => sprintf("The method %s->%s is not covered by tests!", $class, $method),
585 my $r = eval { $self->_resultset->$method(@params) };
587 carp "No method $method found for " . ref($self) . " " . $@;
595 The _type method must be set for all child classes.
596 The value returned by it should be the DBIC resultset name.
597 For example, for holds, _type should return 'Reserve'.
605 This method must be set for all child classes.
606 The value returned by it should be the name of the Koha
607 object class that is returned by this class.
608 For example, for holds, object_class should return 'Koha::Hold'.
618 Kyle M Hall <kyle@bywatersolutions.com>