package Koha::Object;
# Copyright ByWater Solutions 2014
+# Copyright 2016 Koha Development Team
#
# This file is part of Koha.
#
use Modern::Perl;
use Carp;
+use Mojo::JSON;
+use Try::Tiny;
use Koha::Database;
+use Koha::Exceptions::Object;
+use Koha::DateUtils;
=head1 NAME
my $self = {};
if ($attributes) {
- $self->{_result} =
- Koha::Database->new()->schema()->resultset( $class->type() )
+ my $schema = Koha::Database->new->schema;
+
+ # Remove the arguments which exist, are not defined but NOT NULL to use the default value
+ my $columns_info = $schema->resultset( $class->_type )->result_source->columns_info;
+ for my $column_name ( keys %$attributes ) {
+ my $c_info = $columns_info->{$column_name};
+ next if $c_info->{is_nullable};
+ next if not exists $attributes->{$column_name} or defined $attributes->{$column_name};
+ delete $attributes->{$column_name};
+ }
+ $self->{_result} = $schema->resultset( $class->_type() )
->new($attributes);
}
- croak("No type found! Koha::Object must be subclassed!")
- unless $class->type();
+ croak("No _type found! Koha::Object must be subclassed!")
+ unless $class->_type();
bless( $self, $class );
# DBIC result row
$self->{_result} = $dbic_row;
- croak("No type found! Koha::Object must be subclassed!")
- unless $class->type();
+ croak("No _type found! Koha::Object must be subclassed!")
+ unless $class->_type();
- croak( "DBIC result type " . ref( $self->{_result} ) . " isn't of the type " . $class->type() )
- unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->type();
+ croak( "DBIC result _type " . ref( $self->{_result} ) . " isn't of the _type " . $class->_type() )
+ unless ref( $self->{_result} ) eq "Koha::Schema::Result::" . $class->_type();
bless( $self, $class );
sub store {
my ($self) = @_;
- return $self->_result()->update_or_insert() ? $self : undef;
-}
-
-=head3 $object->in_storage();
-
-Returns true if the object has been previously stored.
-
-=cut
-
-sub in_storage {
- my ($self) = @_;
-
- return $self->_result()->in_storage();
-}
-
-=head3 $object->is_changed();
-
-Returns true if the object has properties that are different from
-the properties of the object in storage.
-
-=cut
-
-sub is_changed {
- my ( $self, @columns ) = @_;
-
- return $self->_result()->is_changed(@columns);
+ try {
+ return $self->_result()->update_or_insert() ? $self : undef;
+ }
+ catch {
+ # Catch problems and raise relevant exceptions
+ if (ref($_) eq 'DBIx::Class::Exception') {
+ if ( $_->{msg} =~ /Cannot add or update a child row: a foreign key constraint fails/ ) {
+ # FK constraints
+ # FIXME: MySQL error, if we support more DB engines we should implement this for each
+ if ( $_->{msg} =~ /FOREIGN KEY \(`(?<column>.*?)`\)/ ) {
+ Koha::Exceptions::Object::FKConstraint->throw(
+ error => 'Broken FK constraint',
+ broken_fk => $+{column}
+ );
+ }
+ }
+ elsif( $_->{msg} =~ /Duplicate entry '(.*?)' for key '(?<key>.*?)'/ ) {
+ Koha::Exceptions::Object::DuplicateID->throw(
+ error => 'Duplicate ID',
+ duplicate_id => $+{key}
+ );
+ }
+ # Catch-all for foreign key breakages. It will help find other use cases
+ $->rethrow();
+ }
+ }
}
=head3 $object->delete();
sub delete {
my ($self) = @_;
- # Deleting something not in storage thows an exception
+ # Deleting something not in storage throws an exception
return -1 unless $self->_result()->in_storage();
# Return a boolean for succcess
foreach my $p ( keys %$properties ) {
unless ( grep {/^$p$/} @columns ) {
- carp("No property $p!");
- return 0;
+ Koha::Exceptions::Object::PropertyNotFound->throw( "No property $p for " . ref($self) );
}
}
return $self->_result()->set_columns($properties) ? $self : undef;
}
-=head3 $object->id();
+=head3 $object->unblessed();
+
+Returns an unblessed representation of object.
+
+=cut
+
+sub unblessed {
+ my ($self) = @_;
+
+ return { $self->_result->get_columns };
+}
+
+=head3 $object->TO_JSON
-Returns the id of the object if it has one.
+Returns an unblessed representation of the object, suitable for JSON output.
=cut
-sub id {
+sub TO_JSON {
+
my ($self) = @_;
- my ( $id ) = $self->_result()->id();
+ my $unblessed = $self->unblessed;
+ my $columns_info = Koha::Database->new->schema->resultset( $self->_type )
+ ->result_source->{_columns};
+
+ foreach my $col ( keys %{$columns_info} ) {
+
+ if ( $columns_info->{$col}->{is_boolean} )
+ { # Handle booleans gracefully
+ $unblessed->{$col}
+ = ( $unblessed->{$col} )
+ ? Mojo::JSON->true
+ : Mojo::JSON->false;
+ }
+ elsif ( _numeric_column_type( $columns_info->{$col}->{data_type} ) ) {
+
+ # TODO: Remove once the solution for
+ # https://rt.cpan.org/Ticket/Display.html?id=119904
+ # is ported to whatever distro we support by that time
+ $unblessed->{$col} += 0;
+ }
+ elsif ( _datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
+ eval {
+ return unless $unblessed->{$col};
+ $unblessed->{$col} = output_pref({
+ dateformat => 'rfc3339',
+ dt => dt_from_string($unblessed->{$col}, 'sql'),
+ });
+ };
+ }
+ }
+ return $unblessed;
+}
+
+sub _datetime_column_type {
+ my ($column_type) = @_;
+
+ my @dt_types = (
+ 'timestamp',
+ 'datetime'
+ );
- return $id;
+ return ( grep { $column_type eq $_ } @dt_types) ? 1 : 0;
+}
+
+sub _numeric_column_type {
+ # TODO: Remove once the solution for
+ # https://rt.cpan.org/Ticket/Display.html?id=119904
+ # is ported to whatever distro we support by that time
+ my ($column_type) = @_;
+
+ my @numeric_types = (
+ 'bigint',
+ 'integer',
+ 'int',
+ 'mediumint',
+ 'smallint',
+ 'tinyint',
+ 'decimal',
+ 'double precision',
+ 'float'
+ );
+
+ return ( grep { $column_type eq $_ } @numeric_types) ? 1 : 0;
}
=head3 $object->_result();
# If we don't have a dbic row at this point, we need to create an empty one
$self->{_result} ||=
- Koha::Database->new()->schema()->resultset( $self->type() )->new({});
+ Koha::Database->new()->schema()->resultset( $self->_type() )->new({});
return $self->{_result};
}
return $self->{_columns};
}
-
=head3 AUTOLOAD
The autoload method is used only to get and set values for an objects properties.
}
}
- carp "No method $method!";
- return;
+ my @known_methods = qw( is_changed id in_storage get_column discard_changes update );
+ Koha::Exceptions::Object::MethodNotCoveredByTests->throw( "The method $method is not covered by tests!" ) unless grep {/^$method$/} @known_methods;
+
+ my $r = eval { $self->_result->$method(@_) };
+ if ( $@ ) {
+ Koha::Exceptions::Object->throw( ref($self) . "::$method generated this error: " . $@ );
+ }
+ return $r;
}
-=head3 type
+=head3 _type
This method must be defined in the child class. The value is the name of the DBIC resultset.
-For example, for borrowers, the type method will return "Borrower".
+For example, for borrowers, the _type method will return "Borrower".
=cut
-sub type { }
+sub _type { }
sub DESTROY { }
Kyle M Hall <kyle@bywatersolutions.com>
+Jonathan Druart <jonathan.druart@bugs.koha-community.org>
+
=cut
1;
projects / koha_ffzg / blobdiff