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