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