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