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