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     if (wantarray) {
 146         my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
 147         my $object_class = get_object_class( $dbic_rows[0]->result_class )->[1];
 148
 149         eval "require $object_class";
 150         return $object_class->_wrap(@dbic_rows);
 151
 152     } else {
 153         my $rs = $self->_resultset()->search_related($rel_name, @params);
 154         my $object_class = get_object_class( $rs->result_class )->[1];
 155
 156         eval "require $object_class";
 157         return $object_class->_new_from_dbic($rs);
 158     }
 159 }
 160
 161 =head3 Koha::Objects->next();
 162
 163 my $object = Koha::Objects->next();
 164
 165 Returns the next object that is part of this set.
 166 Returns undef if there are no more objects to return.
 167
 168 =cut
 169
 170 sub next {
 171     my ( $self ) = @_;
 172
 173     my $result = $self->_resultset()->next();
 174     return unless $result;
 175
 176     my $object = $self->object_class()->_new_from_dbic( $result );
 177
 178     return $object;
 179 }
 180
 181 =head3 Koha::Objects->as_list();
 182
 183 Koha::Objects->as_list();
 184
 185 Returns an arrayref of the objects in this set.
 186
 187 =cut
 188
 189 sub as_list {
 190     my ( $self ) = @_;
 191
 192     my @dbic_rows = $self->_resultset()->all();
 193
 194     my @objects = $self->_wrap(@dbic_rows);
 195
 196     return wantarray ? @objects : \@objects;
 197 }
 198
 199 =head3 Koha::Objects->unblessed
 200
 201 Returns an unblessed representation of objects.
 202
 203 =cut
 204
 205 sub unblessed {
 206     my ($self) = @_;
 207
 208     return [ map { $_->unblessed } $self->as_list ];
 209 }
 210
 211 =head3 Koha::Objects->_wrap
 212
 213 wraps the DBIC object in a corresponding Koha object
 214
 215 =cut
 216
 217 sub _wrap {
 218     my ( $self, @dbic_rows ) = @_;
 219
 220     my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
 221
 222     return @objects;
 223 }
 224
 225 =head3 Koha::Objects->_resultset
 226
 227 Returns the internal resultset or creates it if undefined
 228
 229 =cut
 230
 231 sub _resultset {
 232     my ($self) = @_;
 233
 234     if ( ref($self) ) {
 235         $self->{_resultset} ||=
 236           Koha::Database->new()->schema()->resultset( $self->_type() );
 237
 238         return $self->{_resultset};
 239     }
 240     else {
 241         return Koha::Database->new()->schema()->resultset( $self->_type() );
 242     }
 243 }
 244
 245 sub get_object_class {
 246     my ( $type ) = @_;
 247     return unless $type;
 248     $type =~ s|^Koha::Schema::Result::||;
 249     my $mappings = {
 250         Branch => [ qw( Koha::Library Koha::Libraries ) ],
 251         Borrower => [ qw( Koha::Patron Koha::Patrons ) ],
 252         OldIssue => [ qw( Koha::OldIssue Koha::OldIssues ) ],
 253     };
 254     return $mappings->{$type};
 255 }
 256
 257 =head3 columns
 258
 259 my @columns = Koha::Objects->columns
 260
 261 Return the table columns
 262
 263 =cut
 264
 265 sub columns {
 266     my ( $class ) = @_;
 267     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 268 }
 269
 270 =head3 AUTOLOAD
 271
 272 The autoload method is used call DBIx::Class method on a resultset.
 273
 274 Important: If you plan to use one of the DBIx::Class methods you must provide
 275 relevant tests in t/db_dependent/Koha/Objects.t
 276 Currently count, pager, reset, update and delete are covered.
 277
 278 =cut
 279
 280 sub AUTOLOAD {
 281     my ( $self, @params ) = @_;
 282
 283     my @known_methods = qw( count pager reset update delete );
 284     my $method = our $AUTOLOAD;
 285     $method =~ s/.*:://;
 286
 287     carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
 288     my $r = eval { $self->_resultset->$method(@params) };
 289     if ( $@ ) {
 290         carp "No method $method found for " . ref($self) . " " . $@;
 291         return
 292     }
 293     return $r;
 294 }
 295
 296 =head3 _type
 297
 298 The _type method must be set for all child classes.
 299 The value returned by it should be the DBIC resultset name.
 300 For example, for holds, _type should return 'Reserve'.
 301
 302 =cut
 303
 304 sub _type { }
 305
 306 =head3 object_class
 307
 308 This method must be set for all child classes.
 309 The value returned by it should be the name of the Koha
 310 object class that is returned by this class.
 311 For example, for holds, object_class should return 'Koha::Hold'.
 312
 313 =cut
 314
 315 sub object_class { }
 316
 317 sub DESTROY { }
 318
 319 =head1 AUTHOR
 320
 321 Kyle M Hall <kyle@bywatersolutions.com>
 322
 323 =cut
 324
 325 1;