use Modern::Perl;
use Carp;
+use List::MoreUtils qw( none );
use Koha::Database;
=head3 Koha::Objects->find();
-my $object = Koha::Objects->find($id);
-my $object = Koha::Objects->find( { keypart1 => $keypart1, keypart2 => $keypart2 } );
+Similar to DBIx::Class::ResultSet->find this method accepts:
+ \%columns_values | @pk_values, { key => $unique_constraint, %attrs }?
+Strictly speaking, columns_values should only refer to columns under an
+unique constraint.
+
+my $object = Koha::Objects->find( { col1 => $val1, col2 => $val2 } );
+my $object = Koha::Objects->find( $id );
+my $object = Koha::Objects->find( $idpart1, $idpart2, $attrs ); # composite PK
=cut
sub find {
- my ( $self, $id ) = @_;
+ my ( $self, @pars ) = @_;
+
+ croak 'Cannot use "->find" in list context' if wantarray;
- return unless defined($id);
+ return if !@pars || none { defined($_) } @pars;
- my $result = $self->_resultset()->find($id);
+ my $result = $self->_resultset()->find( @pars );
return unless $result;
sub search_related {
my ( $self, $rel_name, @params ) = @_;
+ return if !$rel_name;
if (wantarray) {
my @dbic_rows = $self->_resultset()->search_related($rel_name, @params);
- my $object_class = get_object_class( $dbic_rows[0]->result_class )->[1];
+ return if !@dbic_rows;
+ my $object_class = _get_objects_class( $dbic_rows[0]->result_class );
eval "require $object_class";
- return $object_class->_wrap(@dbic_rows);
+ return _wrap( $object_class, @dbic_rows );
} else {
my $rs = $self->_resultset()->search_related($rel_name, @params);
- my $object_class = get_object_class( $rs->result_class )->[1];
+ return if !$rs;
+ my $object_class = _get_objects_class( $rs->result_class );
eval "require $object_class";
- return $object_class->_new_from_dbic($rs);
+ return _new_from_dbic( $object_class, $rs );
}
}
+=head3 single
+
+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 single {
+ my ($self) = @_;
+
+ my $single = $self->_resultset()->single;
+ return unless $single;
+
+ return $self->object_class()->_new_from_dbic($single);
+}
+
=head3 Koha::Objects->next();
my $object = Koha::Objects->next();
return $object;
}
+=head3 Koha::Objects->last;
+
+my $object = Koha::Objects->last;
+
+Returns the last object that is part of this set.
+Returns undef if there are no object to return.
+
+=cut
+
+sub last {
+ my ( $self ) = @_;
+
+ my $count = $self->_resultset->count;
+ return unless $count;
+
+ my ( $result ) = $self->_resultset->slice($count - 1, $count - 1);
+
+ my $object = $self->object_class()->_new_from_dbic( $result );
+
+ return $object;
+}
+
+
+
+=head3 Koha::Objects->reset();
+
+Koha::Objects->reset();
+
+resets iteration so the next call to next() will start agein
+with the first object in a set.
+
+=cut
+
+sub reset {
+ my ( $self ) = @_;
+
+ $self->_resultset()->reset();
+
+ return $self;
+}
+
=head3 Koha::Objects->as_list();
Koha::Objects->as_list();
return [ map { $_->unblessed } $self->as_list ];
}
+=head3 Koha::Objects->get_column
+
+Return all the values of this set for a given column
+
+=cut
+
+sub get_column {
+ my ($self, $column_name) = @_;
+ return $self->_resultset->get_column( $column_name )->all;
+}
+
+=head3 Koha::Objects->TO_JSON
+
+Returns an unblessed representation of objects, suitable for JSON output.
+
+=cut
+
+sub TO_JSON {
+ my ($self) = @_;
+
+ return [ map { $_->TO_JSON } $self->as_list ];
+}
+
=head3 Koha::Objects->_wrap
wraps the DBIC object in a corresponding Koha object
}
}
-sub get_object_class {
+sub _get_objects_class {
my ( $type ) = @_;
return unless $type;
- $type =~ s|^Koha::Schema::Result::||;
- my $mappings = {
- Branch => [ qw( Koha::Library Koha::Libraries ) ],
- Borrower => [ qw( Koha::Patron Koha::Patrons ) ],
- OldIssue => [ qw( Koha::OldIssue Koha::OldIssues ) ],
- };
- return $mappings->{$type};
+
+ if( $type->can('koha_objects_class') ) {
+ return $type->koha_objects_class;
+ }
+ $type =~ s|Schema::Result::||;
+ return "${type}s";
}
=head3 columns
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, reset, update and delete are covered.
+Currently count, pager, update and delete are covered.
=cut
sub AUTOLOAD {
my ( $self, @params ) = @_;
- my @known_methods = qw( count pager reset update delete );
+ my @known_methods = qw( count is_paged pager update delete result_class single slice );
my $method = our $AUTOLOAD;
$method =~ s/.*:://;
- carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
+
+ unless ( grep { /^$method$/ } @known_methods ) {
+ my $class = ref($self) ? ref($self) : $self;
+ Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
+ error => sprintf("The method %s->%s is not covered by tests!", $class, $method),
+ show_trace => 1
+ );
+ }
+
my $r = eval { $self->_resultset->$method(@params) };
if ( $@ ) {
carp "No method $method found for " . ref($self) . " " . $@;
projects / srvgit / blobdiff