View | Details | Raw Unified | Return to bug 15759
Collapse All | Expand All

(-)a/Koha/Object.pm (-6 / +101 lines)
Lines 23-28 use Carp; Link Here
23
23
24
use Koha::Database;
24
use Koha::Database;
25
25
26
use overload
27
  '%{}' => \&_get_hashref,
28
  '""'  => \&_stringify,
29
  ;
30
26
=head1 NAME
31
=head1 NAME
27
32
28
Koha::Object - Koha Object base class
33
Koha::Object - Koha Object base class
Lines 53-62 Note that this cannot be used to retrieve record from the DB. Link Here
53
58
54
sub new {
59
sub new {
55
    my ( $class, $attributes ) = @_;
60
    my ( $class, $attributes ) = @_;
56
    my $self = {};
61
    my $self = \{};
57
62
58
    if ($attributes) {
63
    if ($attributes) {
59
        $self->{_result} =
64
        $$self->{_result} =
60
          Koha::Database->new()->schema()->resultset( $class->type() )
65
          Koha::Database->new()->schema()->resultset( $class->type() )
61
          ->new($attributes);
66
          ->new($attributes);
62
    }
67
    }
Lines 229-238 sub _result { Link Here
229
    my ($self) = @_;
234
    my ($self) = @_;
230
235
231
    # If we don't have a dbic row at this point, we need to create an empty one
236
    # If we don't have a dbic row at this point, we need to create an empty one
232
    $self->{_result} ||=
237
    $$self->{_result} ||=
233
      Koha::Database->new()->schema()->resultset( $self->type() )->new({});
238
      Koha::Database->new()->schema()->resultset( $self->type() )->new({});
234
239
235
    return $self->{_result};
240
    return $$self->{_result};
236
}
241
}
237
242
238
=head3 $object->_columns();
243
=head3 $object->_columns();
Lines 245-253 sub _columns { Link Here
245
    my ($self) = @_;
250
    my ($self) = @_;
246
251
247
    # If we don't have a dbic row at this point, we need to create an empty one
252
    # If we don't have a dbic row at this point, we need to create an empty one
248
    $self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
253
    $$self->{_columns} ||= [ $self->_result()->result_source()->columns() ];
249
254
250
    return $self->{_columns};
255
    return $$self->{_columns};
251
}
256
}
252
257
253
258
Lines 279-284 sub AUTOLOAD { Link Here
279
    return;
284
    return;
280
}
285
}
281
286
287
=head3 _get_hashref
288
289
This method is used to overload the perl hash dereferencing operator for this class
290
291
=cut
292
293
sub _get_hashref {
294
    my $self = shift;
295
296
    tie my %h, ref $self, $self;
297
298
    return \%h;
299
}
300
301
=head3 _stringify
302
303
This method is used to overload the perl string conversion operator for this class
304
305
=cut
306
307
sub _stringify {
308
    return ref( $_[0] );
309
}
310
311
=head3 TIEHASH
312
313
This method returns our object so Perl treats it has a hashref
314
315
=cut
316
317
sub TIEHASH {
318
    my ( $package, $self ) = @_;
319
    return $self;
320
}
321
322
=head3 STORE
323
324
This method is used when setting a value by treating our object as a hashref.
325
326
This allows
327
328
$object->{key} = $value;
329
330
to be equivilent to
331
332
$object->key($value);
333
334
If the key is not a db column, it is simply stored in the object for later retrieval.
335
336
=cut
337
338
sub STORE {
339
    my ( $self, $key, $value ) = @_;
340
341
    if ( $self->_result()->can($key) ) {
342
        $self->_result()->set_column( $key, $value );
343
    }
344
    else {
345
        $$self->{$key} = $value;
346
    }
347
}
348
349
=head3 FETCH
350
351
This method is used when fetching a value by treating our object as a heashref.
352
353
This allows
354
355
my $value = $object->{key};
356
357
to be equivilent to
358
359
my $value = $object->key();
360
361
If the key is a db column, that value is retrieved,
362
otherwise the object's hashref is accessed to retrieve the value
363
364
=cut
365
366
sub FETCH {
367
    my ( $self, $key ) = @_;
368
369
    if ( $self->_result()->can($key) ) {
370
        return $self->_result()->get_column($key);
371
    }
372
    else {
373
        return $$self->{$key};
374
    }
375
}
376
282
=head3 type
377
=head3 type
283
378
284
This method must be defined in the child class. The value is the name of the DBIC resultset.
379
This method must be defined in the child class. The value is the name of the DBIC resultset.
(-)a/t/db_dependent/Borrower.t (-2 / +5 lines)
Lines 17-23 Link Here
17
17
18
use Modern::Perl;
18
use Modern::Perl;
19
19
20
use Test::More tests => 13;
20
use Test::More tests => 15;
21
use Test::Warn;
21
use Test::Warn;
22
22
23
use C4::Context;
23
use C4::Context;
Lines 64-69 is( $object->is_changed(), 1, "Object is changed after Set" ); Link Here
64
$object->store();
64
$object->store();
65
is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
65
is( $object->is_changed(), 0, "Object no longer marked as changed after being stored" );
66
66
67
is( $object->{firstname}, 'Test Firstname', 'Got first name using object as hashref' );
68
$object->{firstname} = 'Test Firstname 2';
69
is( $object->firstname, 'Test Firstname 2', 'Set first name using object as hashref' );
70
67
$object->delete();
71
$object->delete();
68
$borrower = $schema->resultset('Borrower')->find( $borrowernumber );
72
$borrower = $schema->resultset('Borrower')->find( $borrowernumber );
69
ok( ! $borrower, "Object no longer found in database" );
73
ok( ! $borrower, "Object no longer found in database" );
70
- 

Return to bug 15759