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

(-)a/Koha/Biblio.pm (+105 lines)
Line 0 Link Here
1
package Koha::Biblio;
2
3
# This contains functions to do with managing biblio records.
4
5
# Copyright 2014 Catalyst IT
6
#
7
# This file is part of Koha.
8
#
9
# Koha is free software; you can redistribute it and/or modify it under the
10
# terms of the GNU General Public License as published by the Free Software
11
# Foundation; either version 3 of the License, or (at your option) any later
12
# version.
13
#
14
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License along
19
# with Koha; if not, write to the Free Software Foundation, Inc.,
20
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
=head1 NAME
23
24
Koha::Biblio - contains fundamental biblio-related functions
25
26
=head1 DESCRIPTION
27
28
This contains functions for normal operations on biblio records.
29
30
Note: really, C4::Biblio does the main functions, but the Koha namespace is
31
the new thing that should be used.
32
33
=cut
34
35
use C4::Biblio; # EmbedItemsInMarcBiblio
36
use Koha::Biblio::Iterator;
37
use Koha::Database;
38
use Modern::Perl;
39
40
use base qw(Class::Accessor);
41
42
__PACKAGE__->mk_accessors(qw());
43
44
=head1 FUNCTIONS
45
46
=head2 get_all_biblios_iterator
47
48
    my $it = get_all_biblios_iterator();
49
50
This will provide an iterator object that will, one by one, provide the
51
MARC::Record of each biblio. This will include the item data.
52
53
The iterator is a Koha::Biblio::Iterator object.
54
55
=cut
56
57
sub get_all_biblios_iterator {
58
    my $database = Koha::Database->new();
59
    my $schema   = $database->schema();
60
    my $rs =
61
      $schema->resultset('Biblioitem')->search( { marc => { '!=', undef } },
62
        { columns => [qw/ biblionumber marc /] } );
63
    return Koha::Biblio::Iterator->new($rs, items => 1);
64
}
65
66
=head2 get_marc_biblio
67
68
    my $marc = get_marc_biblio($bibnum, %options);
69
70
This fetches the MARC::Record for the given biblio number. Nothing is returned
71
if the biblionumber couldn't be found (or it somehow has no MARC data.)
72
73
Options are:
74
75
=over 4
76
77
=item item_data
78
79
If set to true, item data is embedded in the record. Default is to not do this.
80
81
=back
82
83
=cut
84
85
sub get_marc_biblio {
86
    my ($class,$bibnum, %options) = @_;
87
88
    my $database = Koha::Database->new();
89
    my $schema   = $database->schema();
90
    my $rs =
91
      $schema->resultset('Biblioitem')
92
      ->search( { marc => { '!=', undef }, biblionumber => $bibnum },
93
        { columns => [qw/ marc /] } );
94
95
    my $row = $rs->next();
96
    return unless $row;
97
    my $marc = MARC::Record->new_from_usmarc($row->marc);
98
99
    # TODO implement this in this module
100
    C4::Biblio::EmbedItemsInMarcBiblio($marc, $bibnum) if $options{item_data};
101
102
    return $marc;
103
}
104
105
1;
(-)a/Koha/Biblio/Iterator.pm (+126 lines)
Line 0 Link Here
1
package Koha::Biblio::Iterator;
2
3
# This contains an iterator over biblio records
4
5
# Copyright 2014 Catalyst IT
6
#
7
# This file is part of Koha.
8
#
9
# Koha is free software; you can redistribute it and/or modify it under the
10
# terms of the GNU General Public License as published by the Free Software
11
# Foundation; either version 3 of the License, or (at your option) any later
12
# version.
13
#
14
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License along
19
# with Koha; if not, write to the Free Software Foundation, Inc.,
20
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
=head1 NAME
23
24
Koha::Biblio::Iterator - iterates over biblios provided by a DBIx::Class::ResultSet
25
26
=head1 DESCRIPTION
27
28
This provides an iterator that gives the MARC::Record of each biblio that's
29
returned by a L<DBIx::Class::ResultSet> that provides a C<biblionumber>, and
30
C<marc> or C<marcxml> column from the biblioitems table.
31
32
=head1 SYNOPSIS
33
34
  use Koha::Biblio::Iterator;
35
  my $rs = $schema->resultset('biblioitems');
36
  my $iterator = Koha::Biblio::Iterator->new($rs);
37
  while (my $record = $iterator->next()) {
38
      // do something with $record
39
  }
40
41
=head1 METHODS
42
43
=cut
44
45
use C4::Biblio;    # :( - for EmbedItemsInMarcBiblio
46
47
use Carp;
48
use MARC::Record;
49
use MARC::File::XML;
50
use Modern::Perl;
51
52
=head2 new
53
54
    my $it = new($sth, option => $value, ...);
55
56
Takes a ResultSet to iterate over, and gives you an iterator on it. Optional
57
options may be specified.
58
59
=head3 Options
60
61
=over 4
62
63
=item items
64
65
Set to true to include item data in the resulting MARC record.
66
67
=back
68
69
=cut
70
71
sub new {
72
    my ( $class, $rs, %options ) = @_;
73
74
    bless {
75
        rs => $rs,
76
        %options,
77
    }, $class;
78
}
79
80
=head2 next()
81
82
In a scalar context, provides the next MARC::Record from the ResultSet, or
83
C<undef> if there are no more.
84
85
In a list context it will provide ($biblionumber, $record).
86
87
=cut
88
89
sub next {
90
    my ($self) = @_;
91
92
    my $marc;
93
    my $row = $self->{rs}->next();
94
    return if !$row;
95
    if ( $row->marc ) {
96
        $marc = MARC::Record->new_from_usmarc( $row->marc );
97
    }
98
    elsif ( $row->marcxml ) {
99
        $marc = MARC::Record->new_from_xml( $row->marcxml );
100
    }
101
    else {
102
        confess "No marc or marcxml column returned in the request.";
103
    }
104
105
    my $bibnum;
106
    if ( $self->{items} ) {
107
        $bibnum = $row->get_column('biblionumber');
108
        confess "No biblionumber column returned in the request."
109
          if ( !defined($bibnum) );
110
111
        # TODO this should really be in Koha::Biblio or something similar.
112
        C4::Biblio::EmbedItemsInMarcBiblio( $marc, $bibnum );
113
    }
114
115
    if (wantarray) {
116
        $bibnum //= $row->get_column('biblionumber');
117
        confess "No biblionumber column returned in the request."
118
          if ( !defined($bibnum) );
119
        return ( $bibnum, $marc );
120
    }
121
    else {
122
        return $marc;
123
    }
124
}
125
126
1;
(-)a/Koha/Database.pm (-60 / +7 lines)
Lines 40-45 use base qw(Class::Accessor); Link Here
40
40
41
__PACKAGE__->mk_accessors(qw( ));
41
__PACKAGE__->mk_accessors(qw( ));
42
42
43
our $schema; # the schema is a singleton
44
43
# _new_schema
45
# _new_schema
44
# Internal helper function (not a method!). This creates a new
46
# Internal helper function (not a method!). This creates a new
45
# database connection from the data given in the current context, and
47
# database connection from the data given in the current context, and
Lines 64-85 creates one, and connects to the database. Link Here
64
66
65
This database handle is cached for future use: if you call
67
This database handle is cached for future use: if you call
66
C<$database-E<gt>schema> twice, you will get the same handle both
68
C<$database-E<gt>schema> twice, you will get the same handle both
67
times. If you need a second database handle, use C<&new_schema> and
69
times. If you need a second database handle, use C<&new_schema>.
68
possibly C<&set_schema>.
69
70
70
=cut
71
=cut
71
72
72
sub schema {
73
sub schema {
73
    my $self = shift;
74
    my $self = shift;
74
    my $sth;
75
    my $sth;
75
    if ( defined( $self->{"schema"} ) && $self->{"schema"}->storage->connected() ) {
76
    if ( defined( $schema ) && $schema->storage->connected() ) {
76
        return $self->{"schema"};
77
        return $schema;
77
    }
78
    }
78
79
79
    # No database handle or it died . Create one.
80
    # No database handle or it died . Create one.
80
    $self->{"schema"} = &_new_schema();
81
    $schema = &_new_schema();
81
82
82
    return $self->{"schema"};
83
    return $schema;
83
}
84
}
84
85
85
=head2 new_schema
86
=head2 new_schema
Lines 102-161 sub new_schema { Link Here
102
    return &_new_schema();
103
    return &_new_schema();
103
}
104
}
104
105
105
=head2 set_schema
106
107
  $my_schema = $database->new_schema;
108
  $database->set_schema($my_schema);
109
  ...
110
  $database->restore_schema;
111
112
C<&set_schema> and C<&restore_schema> work in a manner analogous to
113
C<&set_context> and C<&restore_context>.
114
115
C<&set_schema> saves the current database handle on a stack, then sets
116
the current database handle to C<$my_schema>.
117
118
C<$my_schema> is assumed to be a good database handle.
119
120
=cut
121
122
sub set_schema {
123
    my $self       = shift;
124
    my $new_schema = shift;
125
126
    # Save the current database handle on the handle stack.
127
    # We assume that $new_schema is all good: if the caller wants to
128
    # screw himself by passing an invalid handle, that's fine by
129
    # us.
130
    push @{ $self->{"schema_stack"} }, $self->{"schema"};
131
    $self->{"schema"} = $new_schema;
132
}
133
134
=head2 restore_schema
135
136
  $database->restore_schema;
137
138
Restores the database handle saved by an earlier call to
139
C<$database-E<gt>set_schema>.
140
141
=cut
142
143
sub restore_schema {
144
    my $self = shift;
145
146
    if ( $#{ $self->{"schema_stack"} } < 0 ) {
147
148
        # Stack underflow
149
        die "SCHEMA stack underflow";
150
    }
151
152
    # Pop the old database handle and set it.
153
    $self->{"schema"} = pop @{ $self->{"schema_stack"} };
154
155
    # FIXME - If it is determined that restore_context should
156
    # return something, then this function should, too.
157
}
158
159
=head2 EXPORT
106
=head2 EXPORT
160
107
161
None by default.
108
None by default.
(-)a/Koha/ItemType.pm (+70 lines)
Line 0 Link Here
1
package Koha::ItemType;
2
3
# This represents a single itemtype
4
5
# Copyright 2014 Catalyst IT
6
#
7
# This file is part of Koha.
8
#
9
# Koha is free software; you can redistribute it and/or modify it under the
10
# terms of the GNU General Public License as published by the Free Software
11
# Foundation; either version 3 of the License, or (at your option) any later
12
# version.
13
#
14
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License along
19
# with Koha; if not, write to the Free Software Foundation, Inc.,
20
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
=head1 NAME
23
24
Koha::ItemType - represents a single itemtype
25
26
=head1 DESCRIPTION
27
28
This contains the data relating to a single itemtype
29
30
=head1 SYNOPSIS
31
32
    use Koha::ItemTypes;
33
    my $types = Koha::ItemTypes->new();
34
    my $type  = $types->get_itemtype('CODE');
35
    print $type->code, $type->description, $type->rentalcharge,
36
      $type->imageurl, $type->summary, $type->checkinmsg,
37
      $type->checkinmsgtype;
38
39
Creating an instance of C<Koha::ItemType> without using L<Koha::ItemTypes>
40
can be done simply by passing a hashref containing the values to C<new()>.
41
Note when doing this that a value for C<itemtype> will become a value for
42
C<code>.
43
44
=head1 FUNCTIONS
45
46
In addition to the read-only accessors mentioned above, the following functions
47
exist.
48
49
=cut
50
51
use Modern::Perl;
52
53
use base qw(Class::Accessor);
54
55
# TODO can we make these auto-generate from the input hash so it doesn't
56
# have to be updated when the database is?
57
__PACKAGE__->mk_ro_accessors(
58
    qw(code description rentalcharge imageurl
59
      summary checkinmsg checkinmsgtype)
60
);
61
62
sub new {
63
    my $class = shift @_;
64
65
    my %data = ( %{ $_[0] }, code => $_[0]->{itemtype} );
66
    my $self = $class->SUPER::new( \%data );
67
    return $self;
68
}
69
70
1;
(-)a/Koha/ItemTypes.pm (+113 lines)
Line 0 Link Here
1
package Koha::ItemTypes;
2
3
# This contains the item types that the system knows about.
4
5
# Copyright 2014 Catalyst IT
6
#
7
# This file is part of Koha.
8
#
9
# Koha is free software; you can redistribute it and/or modify it under the
10
# terms of the GNU General Public License as published by the Free Software
11
# Foundation; either version 3 of the License, or (at your option) any later
12
# version.
13
#
14
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License along
19
# with Koha; if not, write to the Free Software Foundation, Inc.,
20
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
=head1 NAME
23
24
Koha::ItemTypes - handles the item types that Koha knows about
25
26
=head1 DESCRIPTION
27
28
This contains functions to access the item types.
29
30
Note that any changes that happen to the database while this object is live
31
may not be reflected, so best don't hold onto it for a long time
32
33
=cut
34
35
use Koha::Database;
36
use Koha::ItemType;
37
use Modern::Perl;
38
39
use Data::Dumper; # TODO remove
40
use base qw(Class::Accessor);
41
42
__PACKAGE__->mk_accessors(qw());
43
44
=head1 FUNCTIONS
45
46
=head2 new
47
48
    my $itypes = Koha::ItemTypes->new();
49
50
Creates a new instance of the object.
51
52
=cut
53
54
# Handled by Class::Accessor
55
56
=head2 get_itemtype
57
58
    my @itype = $itypes->get_itemtype('CODE1', 'CODE2');
59
60
This returns a L<Koha::ItemType> object for each of the provided codes. For
61
any that don't exist, an C<undef> is returned.
62
63
=cut
64
65
sub get_itemtype {
66
    my ($self, @codes) = @_;
67
68
    my $schema = Koha::Database->new()->schema();
69
    my @res;
70
71
    foreach my $c (@codes) {
72
        if (exists $self->{cached}{$c}) {
73
            push @res, $self->{cached}{$c};
74
            next;
75
        }
76
        my $rs = $schema->resultset('Itemtype')->search( { itemtype => $c } );
77
        my $r = $rs->next;
78
        if (!$r) {
79
            push @res, undef;
80
            next;
81
        }
82
        my %data = $r->get_inflated_columns;
83
        my $it = Koha::ItemType->new(\%data);
84
        push @res, $it;
85
        $self->{cached}{$c} = $it;
86
    }
87
    if (wantarray) {
88
        return @res;
89
    } else {
90
        return @res ? $res[0] : undef;
91
    }
92
}
93
94
=head2 get_description_for_code
95
96
    my $desc = $itypes->get_description_for_code($code);
97
98
This returns the description for an itemtype code. As a special case, if
99
there is no itemtype for this code, it'll return what it was given.
100
101
It is mostly as a convenience function rather than using L<get_itemtype>.
102
103
=cut
104
105
sub get_description_for_code {
106
    my ($self, $code) = @_;
107
108
    my $itype = $self->get_itemtype($code);
109
    return $code if !$itype;
110
    return $itype->description;
111
}
112
113
1;
(-)a/t/Koha/ItemType.pm (+46 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
#
3
# Copyright 2014 Catalyst IT
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
22
use Test::More tests => 8;
23
24
BEGIN {
25
    use_ok('Koha::ItemType');
26
}
27
28
my $data = {
29
    itemtype       => 'CODE',
30
    description    => 'description',
31
    rentalcharge   => 'rentalcharge',
32
    imageurl       => 'imageurl',
33
    summary        => 'summary',
34
    checkinmsg     => 'checkinmsg',
35
    checkinmsgtype => 'checkinmsgtype',
36
};
37
38
my $type = Koha::ItemType->new($data);
39
40
is( $type->code,           'CODE',           'itemtype/code' );
41
is( $type->description,    'description',    'description' );
42
is( $type->rentalcharge,   'rentalcharge',   'rentalcharge' );
43
is( $type->imageurl,       'imageurl',       'imageurl' );
44
is( $type->summary,        'summary',        'summary' );
45
is( $type->checkinmsg,     'checkinmsg',     'checkinmsg' );
46
is( $type->checkinmsgtype, 'checkinmsgtype', 'checkinmsgtype' );
(-)a/t/db_dependent/Koha/ItemTypes.pm (-1 / +65 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
#
3
# Copyright 2014 Catalyst IT
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
# XXX This doesn't work because I need to figure out how to do transactions
21
# in a test-case with DBIx::Class
22
23
use Modern::Perl;
24
25
use Test::More tests => 8;
26
use Data::Dumper;
27
28
BEGIN {
29
    use_ok('Koha::ItemTypes');
30
}
31
32
my $dbh = C4::Context->dbh;
33
34
# Start transaction
35
$dbh->{AutoCommit} = 0;
36
$dbh->{RaiseError} = 1;
37
38
my $prep = $dbh->prepare('INSERT INTO itemtypes (itemtype, description, rentalcharge, imageurl, summary, checkinmsg, checkinmsgtype) VALUES (?,?,?,?,?,?,?)');
39
$prep->execute('type1', 'description', 'rentalcharge', 'imageurl', 'summary', 'checkinmsg', 'checkinmsgtype');
40
$prep->execute('type2', 'description', 'rentalcharge', 'imageurl', 'summary', 'checkinmsg', 'checkinmsgtype');
41
42
my $itypes = Koha::ItemTypes->new();
43
44
my @types = $itypes->get_itemtype('type1', 'type2');
45
46
die Dumper(\@types);
47
my $type = $types[0];
48
ok(defined($type), 'first result');
49
is( $type->code,           'type1',           'itemtype/code' );
50
is( $type->description,    'description',    'description' );
51
is( $type->rentalcharge,   'rentalcharge',   'rentalcharge' );
52
is( $type->imageurl,       'imageurl',       'imageurl' );
53
is( $type->summary,        'summary',        'summary' );
54
is( $type->checkinmsg,     'checkinmsg',     'checkinmsg' );
55
is( $type->checkinmsgtype, 'checkinmsgtype', 'checkinmsgtype' );
56
57
$type = $types[1];
58
ok(defined($type), 'second result');
59
is( $type->code,           'type2',           'itemtype/code' );
60
is( $type->description,    'description',    'description' );
61
is( $type->rentalcharge,   'rentalcharge',   'rentalcharge' );
62
is( $type->imageurl,       'imageurl',       'imageurl' );
63
is( $type->summary,        'summary',        'summary' );
64
is( $type->checkinmsg,     'checkinmsg',     'checkinmsg' );
65
is( $type->checkinmsgtype, 'checkinmsgtype', 'checkinmsgtype' );

Return to bug 12478