@@ -, +, @@ depend on --- Koha/Biblio.pm | 105 ++++++++++++++++++++++++++++++++ Koha/Biblio/Iterator.pm | 126 +++++++++++++++++++++++++++++++++++++++ Koha/Database.pm | 67 +++------------------ Koha/ItemType.pm | 70 ++++++++++++++++++++++ Koha/ItemTypes.pm | 113 +++++++++++++++++++++++++++++++++++ t/Koha/ItemType.pm | 46 ++++++++++++++ t/db_dependent/Koha/ItemTypes.pm | 65 ++++++++++++++++++++ 7 files changed, 532 insertions(+), 60 deletions(-) create mode 100644 Koha/Biblio.pm create mode 100644 Koha/Biblio/Iterator.pm create mode 100644 Koha/ItemType.pm create mode 100644 Koha/ItemTypes.pm create mode 100755 t/Koha/ItemType.pm create mode 100755 t/db_dependent/Koha/ItemTypes.pm --- a/Koha/Biblio.pm +++ a/Koha/Biblio.pm @@ -0,0 +1,105 @@ +package Koha::Biblio; + +# This contains functions to do with managing biblio records. + +# Copyright 2014 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + +Koha::Biblio - contains fundamental biblio-related functions + +=head1 DESCRIPTION + +This contains functions for normal operations on biblio records. + +Note: really, C4::Biblio does the main functions, but the Koha namespace is +the new thing that should be used. + +=cut + +use C4::Biblio; # EmbedItemsInMarcBiblio +use Koha::Biblio::Iterator; +use Koha::Database; +use Modern::Perl; + +use base qw(Class::Accessor); + +__PACKAGE__->mk_accessors(qw()); + +=head1 FUNCTIONS + +=head2 get_all_biblios_iterator + + my $it = get_all_biblios_iterator(); + +This will provide an iterator object that will, one by one, provide the +MARC::Record of each biblio. This will include the item data. + +The iterator is a Koha::Biblio::Iterator object. + +=cut + +sub get_all_biblios_iterator { + my $database = Koha::Database->new(); + my $schema = $database->schema(); + my $rs = + $schema->resultset('Biblioitem')->search( { marc => { '!=', undef } }, + { columns => [qw/ biblionumber marc /] } ); + return Koha::Biblio::Iterator->new($rs, items => 1); +} + +=head2 get_marc_biblio + + my $marc = get_marc_biblio($bibnum, %options); + +This fetches the MARC::Record for the given biblio number. Nothing is returned +if the biblionumber couldn't be found (or it somehow has no MARC data.) + +Options are: + +=over 4 + +=item item_data + +If set to true, item data is embedded in the record. Default is to not do this. + +=back + +=cut + +sub get_marc_biblio { + my ($class,$bibnum, %options) = @_; + + my $database = Koha::Database->new(); + my $schema = $database->schema(); + my $rs = + $schema->resultset('Biblioitem') + ->search( { marc => { '!=', undef }, biblionumber => $bibnum }, + { columns => [qw/ marc /] } ); + + my $row = $rs->next(); + return unless $row; + my $marc = MARC::Record->new_from_usmarc($row->marc); + + # TODO implement this in this module + C4::Biblio::EmbedItemsInMarcBiblio($marc, $bibnum) if $options{item_data}; + + return $marc; +} + +1; --- a/Koha/Biblio/Iterator.pm +++ a/Koha/Biblio/Iterator.pm @@ -0,0 +1,126 @@ +package Koha::Biblio::Iterator; + +# This contains an iterator over biblio records + +# Copyright 2014 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + +Koha::Biblio::Iterator - iterates over biblios provided by a DBIx::Class::ResultSet + +=head1 DESCRIPTION + +This provides an iterator that gives the MARC::Record of each biblio that's +returned by a L that provides a C, and +C or C column from the biblioitems table. + +=head1 SYNOPSIS + + use Koha::Biblio::Iterator; + my $rs = $schema->resultset('biblioitems'); + my $iterator = Koha::Biblio::Iterator->new($rs); + while (my $record = $iterator->next()) { + // do something with $record + } + +=head1 METHODS + +=cut + +use C4::Biblio; # :( - for EmbedItemsInMarcBiblio + +use Carp; +use MARC::Record; +use MARC::File::XML; +use Modern::Perl; + +=head2 new + + my $it = new($sth, option => $value, ...); + +Takes a ResultSet to iterate over, and gives you an iterator on it. Optional +options may be specified. + +=head3 Options + +=over 4 + +=item items + +Set to true to include item data in the resulting MARC record. + +=back + +=cut + +sub new { + my ( $class, $rs, %options ) = @_; + + bless { + rs => $rs, + %options, + }, $class; +} + +=head2 next() + +In a scalar context, provides the next MARC::Record from the ResultSet, or +C if there are no more. + +In a list context it will provide ($biblionumber, $record). + +=cut + +sub next { + my ($self) = @_; + + my $marc; + my $row = $self->{rs}->next(); + return if !$row; + if ( $row->marc ) { + $marc = MARC::Record->new_from_usmarc( $row->marc ); + } + elsif ( $row->marcxml ) { + $marc = MARC::Record->new_from_xml( $row->marcxml ); + } + else { + confess "No marc or marcxml column returned in the request."; + } + + my $bibnum; + if ( $self->{items} ) { + $bibnum = $row->get_column('biblionumber'); + confess "No biblionumber column returned in the request." + if ( !defined($bibnum) ); + + # TODO this should really be in Koha::Biblio or something similar. + C4::Biblio::EmbedItemsInMarcBiblio( $marc, $bibnum ); + } + + if (wantarray) { + $bibnum //= $row->get_column('biblionumber'); + confess "No biblionumber column returned in the request." + if ( !defined($bibnum) ); + return ( $bibnum, $marc ); + } + else { + return $marc; + } +} + +1; --- a/Koha/Database.pm +++ a/Koha/Database.pm @@ -40,6 +40,8 @@ use base qw(Class::Accessor); __PACKAGE__->mk_accessors(qw( )); +our $schema; # the schema is a singleton + # _new_schema # Internal helper function (not a method!). This creates a new # database connection from the data given in the current context, and @@ -64,22 +66,21 @@ creates one, and connects to the database. This database handle is cached for future use: if you call C<$database-Eschema> twice, you will get the same handle both -times. If you need a second database handle, use C<&new_schema> and -possibly C<&set_schema>. +times. If you need a second database handle, use C<&new_schema>. =cut sub schema { my $self = shift; my $sth; - if ( defined( $self->{"schema"} ) && $self->{"schema"}->storage->connected() ) { - return $self->{"schema"}; + if ( defined( $schema ) && $schema->storage->connected() ) { + return $schema; } # No database handle or it died . Create one. - $self->{"schema"} = &_new_schema(); + $schema = &_new_schema(); - return $self->{"schema"}; + return $schema; } =head2 new_schema @@ -102,60 +103,6 @@ sub new_schema { return &_new_schema(); } -=head2 set_schema - - $my_schema = $database->new_schema; - $database->set_schema($my_schema); - ... - $database->restore_schema; - -C<&set_schema> and C<&restore_schema> work in a manner analogous to -C<&set_context> and C<&restore_context>. - -C<&set_schema> saves the current database handle on a stack, then sets -the current database handle to C<$my_schema>. - -C<$my_schema> is assumed to be a good database handle. - -=cut - -sub set_schema { - my $self = shift; - my $new_schema = shift; - - # Save the current database handle on the handle stack. - # We assume that $new_schema is all good: if the caller wants to - # screw himself by passing an invalid handle, that's fine by - # us. - push @{ $self->{"schema_stack"} }, $self->{"schema"}; - $self->{"schema"} = $new_schema; -} - -=head2 restore_schema - - $database->restore_schema; - -Restores the database handle saved by an earlier call to -C<$database-Eset_schema>. - -=cut - -sub restore_schema { - my $self = shift; - - if ( $#{ $self->{"schema_stack"} } < 0 ) { - - # Stack underflow - die "SCHEMA stack underflow"; - } - - # Pop the old database handle and set it. - $self->{"schema"} = pop @{ $self->{"schema_stack"} }; - - # FIXME - If it is determined that restore_context should - # return something, then this function should, too. -} - =head2 EXPORT None by default. --- a/Koha/ItemType.pm +++ a/Koha/ItemType.pm @@ -0,0 +1,70 @@ +package Koha::ItemType; + +# This represents a single itemtype + +# Copyright 2014 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + +Koha::ItemType - represents a single itemtype + +=head1 DESCRIPTION + +This contains the data relating to a single itemtype + +=head1 SYNOPSIS + + use Koha::ItemTypes; + my $types = Koha::ItemTypes->new(); + my $type = $types->get_itemtype('CODE'); + print $type->code, $type->description, $type->rentalcharge, + $type->imageurl, $type->summary, $type->checkinmsg, + $type->checkinmsgtype; + +Creating an instance of C without using L +can be done simply by passing a hashref containing the values to C. +Note when doing this that a value for C will become a value for +C. + +=head1 FUNCTIONS + +In addition to the read-only accessors mentioned above, the following functions +exist. + +=cut + +use Modern::Perl; + +use base qw(Class::Accessor); + +# TODO can we make these auto-generate from the input hash so it doesn't +# have to be updated when the database is? +__PACKAGE__->mk_ro_accessors( + qw(code description rentalcharge imageurl + summary checkinmsg checkinmsgtype) +); + +sub new { + my $class = shift @_; + + my %data = ( %{ $_[0] }, code => $_[0]->{itemtype} ); + my $self = $class->SUPER::new( \%data ); + return $self; +} + +1; --- a/Koha/ItemTypes.pm +++ a/Koha/ItemTypes.pm @@ -0,0 +1,113 @@ +package Koha::ItemTypes; + +# This contains the item types that the system knows about. + +# Copyright 2014 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + +Koha::ItemTypes - handles the item types that Koha knows about + +=head1 DESCRIPTION + +This contains functions to access the item types. + +Note that any changes that happen to the database while this object is live +may not be reflected, so best don't hold onto it for a long time + +=cut + +use Koha::Database; +use Koha::ItemType; +use Modern::Perl; + +use Data::Dumper; # TODO remove +use base qw(Class::Accessor); + +__PACKAGE__->mk_accessors(qw()); + +=head1 FUNCTIONS + +=head2 new + + my $itypes = Koha::ItemTypes->new(); + +Creates a new instance of the object. + +=cut + +# Handled by Class::Accessor + +=head2 get_itemtype + + my @itype = $itypes->get_itemtype('CODE1', 'CODE2'); + +This returns a L object for each of the provided codes. For +any that don't exist, an C is returned. + +=cut + +sub get_itemtype { + my ($self, @codes) = @_; + + my $schema = Koha::Database->new()->schema(); + my @res; + + foreach my $c (@codes) { + if (exists $self->{cached}{$c}) { + push @res, $self->{cached}{$c}; + next; + } + my $rs = $schema->resultset('Itemtype')->search( { itemtype => $c } ); + my $r = $rs->next; + if (!$r) { + push @res, undef; + next; + } + my %data = $r->get_inflated_columns; + my $it = Koha::ItemType->new(\%data); + push @res, $it; + $self->{cached}{$c} = $it; + } + if (wantarray) { + return @res; + } else { + return @res ? $res[0] : undef; + } +} + +=head2 get_description_for_code + + my $desc = $itypes->get_description_for_code($code); + +This returns the description for an itemtype code. As a special case, if +there is no itemtype for this code, it'll return what it was given. + +It is mostly as a convenience function rather than using L. + +=cut + +sub get_description_for_code { + my ($self, $code) = @_; + + my $itype = $self->get_itemtype($code); + return $code if !$itype; + return $itype->description; +} + +1; --- a/t/Koha/ItemType.pm +++ a/t/Koha/ItemType.pm @@ -0,0 +1,46 @@ +#!/usr/bin/perl +# +# Copyright 2014 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use Test::More tests => 8; + +BEGIN { + use_ok('Koha::ItemType'); +} + +my $data = { + itemtype => 'CODE', + description => 'description', + rentalcharge => 'rentalcharge', + imageurl => 'imageurl', + summary => 'summary', + checkinmsg => 'checkinmsg', + checkinmsgtype => 'checkinmsgtype', +}; + +my $type = Koha::ItemType->new($data); + +is( $type->code, 'CODE', 'itemtype/code' ); +is( $type->description, 'description', 'description' ); +is( $type->rentalcharge, 'rentalcharge', 'rentalcharge' ); +is( $type->imageurl, 'imageurl', 'imageurl' ); +is( $type->summary, 'summary', 'summary' ); +is( $type->checkinmsg, 'checkinmsg', 'checkinmsg' ); +is( $type->checkinmsgtype, 'checkinmsgtype', 'checkinmsgtype' ); --- a/t/db_dependent/Koha/ItemTypes.pm +++ a/t/db_dependent/Koha/ItemTypes.pm @@ -0,0 +1,65 @@ +#!/usr/bin/perl +# +# Copyright 2014 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +# XXX This doesn't work because I need to figure out how to do transactions +# in a test-case with DBIx::Class + +use Modern::Perl; + +use Test::More tests => 8; +use Data::Dumper; + +BEGIN { + use_ok('Koha::ItemTypes'); +} + +my $dbh = C4::Context->dbh; + +# Start transaction +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + +my $prep = $dbh->prepare('INSERT INTO itemtypes (itemtype, description, rentalcharge, imageurl, summary, checkinmsg, checkinmsgtype) VALUES (?,?,?,?,?,?,?)'); +$prep->execute('type1', 'description', 'rentalcharge', 'imageurl', 'summary', 'checkinmsg', 'checkinmsgtype'); +$prep->execute('type2', 'description', 'rentalcharge', 'imageurl', 'summary', 'checkinmsg', 'checkinmsgtype'); + +my $itypes = Koha::ItemTypes->new(); + +my @types = $itypes->get_itemtype('type1', 'type2'); + +die Dumper(\@types); +my $type = $types[0]; +ok(defined($type), 'first result'); +is( $type->code, 'type1', 'itemtype/code' ); +is( $type->description, 'description', 'description' ); +is( $type->rentalcharge, 'rentalcharge', 'rentalcharge' ); +is( $type->imageurl, 'imageurl', 'imageurl' ); +is( $type->summary, 'summary', 'summary' ); +is( $type->checkinmsg, 'checkinmsg', 'checkinmsg' ); +is( $type->checkinmsgtype, 'checkinmsgtype', 'checkinmsgtype' ); + +$type = $types[1]; +ok(defined($type), 'second result'); +is( $type->code, 'type2', 'itemtype/code' ); +is( $type->description, 'description', 'description' ); +is( $type->rentalcharge, 'rentalcharge', 'rentalcharge' ); +is( $type->imageurl, 'imageurl', 'imageurl' ); +is( $type->summary, 'summary', 'summary' ); +is( $type->checkinmsg, 'checkinmsg', 'checkinmsg' ); +is( $type->checkinmsgtype, 'checkinmsgtype', 'checkinmsgtype' ); --