Bug 18014: Add test to AuthoritiesMarc.t to expose problem in AddAuthority

[srvgit] / Koha / Objects.pm

diff --git a/Koha/Objects.pm b/Koha/Objects.pm
index c365e7f..9231206 100644 (file)
--- a/Koha/Objects.pm
+++ b/Koha/Objects.pm
@@ -130,27 +130,59 @@ sub search {
     }
 }
 
-=head3 Koha::Objects->count();
+=head3 search_related
 
-my @objects = Koha::Objects->count($params);
+    my @objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
+    my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
+
+Searches the specified relationship, optionally specifying a condition and attributes for matching records.
 
 =cut
 
-sub count {
-    my ( $self, $params ) = @_;
+sub search_related {
+    my ( $self, $rel_name, @params ) = @_;
+
+    return if !$rel_name;
+    if (wantarray) {
+        my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
+        return if !@dbic_rows;
+        my $object_class = _get_objects_class( $dbic_rows[0]->result_class );
 
-    return $self->_resultset()->count($params);
+        eval "require $object_class";
+        return _wrap( $object_class, @dbic_rows );
+
+    } else {
+        my $rs = $self->_resultset()->search_related($rel_name, @params);
+        return if !$rs;
+        my $object_class = _get_objects_class( $rs->result_class );
+
+        eval "require $object_class";
+        return _new_from_dbic( $object_class, $rs );
+    }
 }
 
-=head3 Koha::Objects->pager();
+=head3 single
 
-my $pager = Koha::Objects->pager;
+my $object = Koha::Objects->search({}, { rows => 1 })->single
+
+Returns one and only one object that is part of this set.
+Returns undef if there are no objects found.
+
+This is optimal as it will grab the first returned result without instantiating
+a cursor.
+
+See:
+http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod#Retrieve_one_and_only_one_row_from_a_resultset
 
 =cut
 
-sub pager {
-    my ( $self ) = @_;
-    return $self->_resultset->pager;
+sub single {
+    my ($self) = @_;
+
+    my $single = $self->_resultset()->single;
+    return unless $single;
+
+    return $self->object_class()->_new_from_dbic($single);
 }
 
 =head3 Koha::Objects->next();
@@ -229,7 +261,7 @@ wraps the DBIC object in a corresponding Koha object
 sub _wrap {
     my ( $self, @dbic_rows ) = @_;
 
-    my @objects = map { $self->object_class()->_new_from_dbic( $_ ) } @dbic_rows;
+    my @objects = map { $self->object_class->_new_from_dbic( $_ ) } @dbic_rows;
 
     return @objects;
 }
@@ -254,6 +286,17 @@ sub _resultset {
     }
 }
 
+sub _get_objects_class {
+    my ( $type ) = @_;
+    return unless $type;
+
+    if( $type->can('koha_objects_class') ) {
+        return $type->koha_objects_class;
+    }
+    $type =~ s|Schema::Result::||;
+    return "${type}s";
+}
+
 =head3 columns
 
 my @columns = Koha::Objects->columns
@@ -267,7 +310,31 @@ sub columns {
     return Koha::Database->new->schema->resultset( $class->_type )->result_source->columns;
 }
 
+=head3 AUTOLOAD
+
+The autoload method is used call DBIx::Class method on a resultset.
+
+Important: If you plan to use one of the DBIx::Class methods you must provide
+relevant tests in t/db_dependent/Koha/Objects.t
+Currently count, pager, update and delete are covered.
 
+=cut
+
+sub AUTOLOAD {
+    my ( $self, @params ) = @_;
+
+    my @known_methods = qw( count pager update delete result_class single );
+    my $method = our $AUTOLOAD;
+    $method =~ s/.*:://;
+
+    carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
+    my $r = eval { $self->_resultset->$method(@params) };
+    if ( $@ ) {
+        carp "No method $method found for " . ref($self) . " " . $@;
+        return
+    }
+    return $r;
+}
 
 =head3 _type