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

(-)a/C4/AuthoritiesMarc.pm (-3 / +4 lines)
Lines 26-32 use C4::AuthoritiesMarc::MARC21; Link Here
26
use C4::AuthoritiesMarc::UNIMARC;
26
use C4::AuthoritiesMarc::UNIMARC;
27
use C4::Charset;
27
use C4::Charset;
28
use C4::Log;
28
use C4::Log;
29
use Koha::Authority;
29
use Koha::DataObject::Authority;
30
30
31
use vars qw($VERSION @ISA @EXPORT);
31
use vars qw($VERSION @ISA @EXPORT);
32
32
Lines 849-856 Returns MARC::Record of the authority passed in parameter. Link Here
849
849
850
sub GetAuthority {
850
sub GetAuthority {
851
    my ($authid)=@_;
851
    my ($authid)=@_;
852
    my $authority = Koha::Authority->get_from_authid($authid);
852
    my $authority = Koha::DataObject::Authority->new( { authid => $authid } );
853
    return ($authority->record);
853
    return unless $authority;
854
    return ($authority->marcrecord);
854
}
855
}
855
856
856
=head2 GetAuthType 
857
=head2 GetAuthType 
(-)a/Koha/Authority.pm (-92 lines)
Lines 1-92 Link Here
1
package Koha::Authority;
2
3
# Copyright 2012 C & P Bibliography Services
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 2 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
=head1 NAME
21
22
Koha::Authority - class to encapsulate authority records in Koha
23
24
=head1 SYNOPSIS
25
26
Object-oriented class that encapsulates authority records in Koha.
27
28
=head1 DESCRIPTION
29
30
Authority data.
31
32
=cut
33
34
use strict;
35
use warnings;
36
use C4::Context;
37
use MARC::Record;
38
use MARC::File::XML;
39
use C4::Charset;
40
41
use base qw(Class::Accessor);
42
43
__PACKAGE__->mk_accessors(qw( authid authtype record marcflavour ));
44
45
=head2 new
46
47
    my $auth = Koha::Authority->new($record);
48
49
Create a new Koha::Authority object based on the provided record.
50
51
=cut
52
sub new {
53
    my $class = shift;
54
    my $record = shift;
55
56
    my $self = $class->SUPER::new( { record => $record });
57
58
    bless $self, $class;
59
    return $self;
60
}
61
62
=head2 get_from_authid
63
64
    my $auth = Koha::Authority->get_from_authid($authid);
65
66
Create the Koha::Authority object associated with the provided authid.
67
68
=cut
69
sub get_from_authid {
70
    my $class = shift;
71
    my $authid = shift;
72
    my $marcflavour = C4::Context->preference("marcflavour");
73
74
    my $dbh=C4::Context->dbh;
75
    my $sth=$dbh->prepare("select authtypecode, marcxml from auth_header where authid=?");
76
    $sth->execute($authid);
77
    my ($authtypecode, $marcxml) = $sth->fetchrow;
78
    my $record=eval {MARC::Record->new_from_xml(StripNonXmlChars($marcxml),'UTF-8',
79
        (C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")))};
80
    return undef if ($@);
81
    $record->encoding('UTF-8');
82
83
    my $self = $class->SUPER::new( { authid => $authid,
84
                                     marcflavour => $marcflavour,
85
                                     authtype => $authtypecode,
86
                                     record => $record });
87
88
    bless $self, $class;
89
    return $self;
90
}
91
92
1;
(-)a/Koha/DataObject/Authority.pm (+102 lines)
Line 0 Link Here
1
package Koha::DataObject::Authority;
2
3
# Copyright 2012 C & P Bibliography Services
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 2 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
=head1 NAME
21
22
Koha::DataObject::Authority - class to encapsulate authority records in Koha
23
24
=head1 SYNOPSIS
25
26
Object-oriented class that encapsulates authority records in Koha.
27
28
=head1 DESCRIPTION
29
30
Authority data.
31
32
=cut
33
34
use Modern::Perl;
35
use C4::Context;
36
use MARC::Record;
37
use MARC::File::XML;
38
use C4::Charset;
39
use Class::Accessor "antlers";
40
41
has authid      => ( is => 'rw' );
42
has authtype    => ( is => 'rw' );
43
has marcrecord  => ( is => 'rw' );
44
has marcflavour => ( is => 'rw' );
45
46
=head2 new
47
48
    my $auth = Koha::DataObject::Authority->new($args);
49
50
Create a new Koha::DataObject::Authority object based on the criteria in
51
the provided hashref. If $args->{marcrecord} contains a MARC::Record
52
object, create the Authority object based on that. If $args->{authid}
53
is set, retrieve the authority with the specified authid.
54
55
=cut
56
57
sub new {
58
    my $class = shift;
59
    my $args  = shift;
60
61
    my $self = $class->SUPER::new();
62
    if ( defined $args->{'marcrecord'}
63
        && ref $args->{'marcrecord'} eq 'MARC::Record' )
64
    {
65
        $self = $class->SUPER::new( { marcrecord => $args->{'marcrecord'} } );
66
    }
67
    elsif ( defined $args->{'authid'} ) {
68
        my $marcflavour = C4::Context->preference("marcflavour");
69
        my $dbh         = C4::Context->dbh;
70
        my $sth         = $dbh->prepare(
71
            "select authtypecode, marcxml from auth_header where authid=?");
72
        $sth->execute( $args->{'authid'} );
73
        my ( $authtypecode, $marcxml ) = $sth->fetchrow;
74
        my $record = eval {
75
            MARC::Record->new_from_xml(
76
                StripNonXmlChars($marcxml),
77
                'UTF-8',
78
                (
79
                    C4::Context->preference("marcflavour") eq "UNIMARC"
80
                    ? "UNIMARCAUTH"
81
                    : C4::Context->preference("marcflavour")
82
                )
83
            );
84
        };
85
        return if ($@);
86
        $record->encoding('UTF-8');
87
88
        $self = $class->SUPER::new(
89
            {
90
                authid      => $args->{'authid'},
91
                marcflavour => $marcflavour,
92
                authtype    => $authtypecode,
93
                marcrecord  => $record
94
            }
95
        );
96
    }
97
98
    bless $self, $class;
99
    return $self;
100
}
101
102
1;
(-)a/Koha/Filter/MARC/EmbedSeeFromHeadings.pm (-19 / +22 lines)
Lines 30-42 Filter to embed see from headings into MARC records. Link Here
30
30
31
=cut
31
=cut
32
32
33
use strict;
33
use Modern::Perl;
34
use warnings;
35
use Carp;
34
use Carp;
36
use Koha::Authority;
35
use Koha::DataObject::Authority;
37
36
38
use base qw(Koha::RecordProcessor::Base);
37
use base qw(Koha::RecordProcessor::Base);
39
our $NAME = 'EmbedSeeFromHeadings';
38
our $NAME    = 'EmbedSeeFromHeadings';
40
our $VERSION = '1.0';
39
our $VERSION = '1.0';
41
40
42
=head2 filter
41
=head2 filter
Lines 49-68 In order to differentiate added headings from actual headings, a 'z' is Link Here
49
put in the first indicator.
48
put in the first indicator.
50
49
51
=cut
50
=cut
51
52
sub filter {
52
sub filter {
53
    my $self = shift;
53
    my $self   = shift;
54
    my $record = shift;
54
    my $record = shift;
55
    my $newrecord;
55
    my $newrecord;
56
56
57
    return undef unless defined $record;
57
    return unless defined $record;
58
58
59
    if (ref $record eq 'ARRAY') {
59
    if ( ref $record eq 'ARRAY' ) {
60
        my @recarray;
60
        my @recarray;
61
        foreach my $thisrec (@$record) {
61
        foreach my $thisrec (@$record) {
62
            push @recarray, _processrecord($thisrec);
62
            push @recarray, _processrecord($thisrec);
63
        }
63
        }
64
        $newrecord = \@recarray;
64
        $newrecord = \@recarray;
65
    } elsif (ref $record eq 'MARC::Record') {
65
    }
66
    elsif ( ref $record eq 'MARC::Record' ) {
66
        $newrecord = _processrecord($record);
67
        $newrecord = _processrecord($record);
67
    }
68
    }
68
69
Lines 78-100 sub _processrecord { Link Here
78
79
79
        next unless $authid;
80
        next unless $authid;
80
81
81
        my $authority = Koha::Authority->get_from_authid($authid);
82
        my $authority =
83
          Koha::DataObject::Authority->new( { authid => $authid } );
82
        next unless $authority;
84
        next unless $authority;
83
        my $auth_marc = $authority->record;
85
        my $auth_marc = $authority->marcrecord;
84
        my @seefrom = $auth_marc->field('4..');
86
        my @seefrom   = $auth_marc->field('4..');
85
        my @newfields;
87
        my @newfields;
86
        foreach my $authfield (@seefrom) {
88
        foreach my $authfield (@seefrom) {
87
            my $tag = substr($field->tag(), 0, 1) . substr($authfield->tag(), 1, 2);
89
            my $tag =
88
            my $newfield = MARC::Field->new($tag,
90
              substr( $field->tag(), 0, 1 ) . substr( $authfield->tag(), 1, 2 );
89
                    'z',
91
            my $newfield =
90
                    $authfield->indicator(2) || ' ',
92
              MARC::Field->new( $tag, 'z', $authfield->indicator(2) || ' ',
91
                    '9' => '1');
93
                '9' => '1' );
92
            foreach my $sub ($authfield->subfields()) {
94
            foreach my $sub ( $authfield->subfields() ) {
93
                my ($code,$val) = @$sub;
95
                my ( $code, $val ) = @$sub;
94
                $newfield->add_subfields( $code => $val );
96
                $newfield->add_subfields( $code => $val );
95
            }
97
            }
96
            $newfield->delete_subfield( code => '9' );
98
            $newfield->delete_subfield( code => '9' );
97
            push @newfields, $newfield if (scalar($newfield->subfields()) > 0);
99
            push @newfields, $newfield
100
              if ( scalar( $newfield->subfields() ) > 0 );
98
        }
101
        }
99
        $record->append_fields(@newfields);
102
        $record->append_fields(@newfields);
100
    }
103
    }
(-)a/Koha/Filter/MARC/Null.pm (-4 / +4 lines)
Lines 31-42 RecordProcessor. Link Here
31
31
32
=cut
32
=cut
33
33
34
use strict;
34
use Modern::Perl;
35
use warnings;
36
use Carp;
35
use Carp;
37
36
38
use base qw(Koha::RecordProcessor::Base);
37
use base qw(Koha::RecordProcessor::Base);
39
our $NAME = 'Null';
38
our $NAME    = 'Null';
40
our $VERSION = '1.0';
39
our $VERSION = '1.0';
41
40
42
=head2 filter
41
=head2 filter
Lines 47-54 our $VERSION = '1.0'; Link Here
47
Return the original record.
46
Return the original record.
48
47
49
=cut
48
=cut
49
50
sub filter {
50
sub filter {
51
    my $self = shift;
51
    my $self   = shift;
52
    my $record = shift;
52
    my $record = shift;
53
53
54
    return $record;
54
    return $record;
(-)a/Koha/RecordProcessor.pm (-19 / +28 lines)
Lines 57-70 clone it I<prior> to passing it off to the RecordProcessor. Link Here
57
57
58
=cut
58
=cut
59
59
60
use strict;
60
use Modern::Perl;
61
use warnings;
61
use Class::Accessor "antlers";
62
use Module::Load::Conditional qw(can_load);
62
use Module::Load::Conditional qw(can_load);
63
use Module::Pluggable::Object;
63
use Module::Pluggable::Object;
64
64
65
use base qw(Class::Accessor);
65
has schema  => ( is => "rw" );
66
66
has filters => ( is => "rw" );
67
__PACKAGE__->mk_accessors(qw( schema filters options record ));
67
has options => ( is => "rw" );
68
has record  => ( is => "rw" );
68
69
69
=head2 new
70
=head2 new
70
71
Lines 89-116 Koha::Filter::${schema} namespace, as only the filter name, and Link Here
89
=back
90
=back
90
91
91
=cut
92
=cut
93
92
sub new {
94
sub new {
93
    my $class = shift;
95
    my $class = shift;
94
    my $param = shift;
96
    my $param = shift;
95
97
96
98
    my $schema  = $param->{schema}  || 'MARC';
97
    my $schema = $param->{schema} || 'MARC';
98
    my $options = $param->{options} || '';
99
    my $options = $param->{options} || '';
99
    my @filters = ( );
100
    my @filters = ();
100
101
101
    foreach my $filter ($param->{filters}) {
102
    foreach my $filter ( $param->{filters} ) {
102
        next unless $filter;
103
        next unless $filter;
103
        my $filter_module = $filter =~ m/:/ ? $filter : "Koha::Filter::${schema}::${filter}";
104
        my $filter_module =
104
        if (can_load( modules => { $filter_module => undef } )) {
105
          $filter =~ m/:/ ? $filter : "Koha::Filter::${schema}::${filter}";
106
        if ( can_load( modules => { $filter_module => undef } ) ) {
105
            my $object = $filter_module->new();
107
            my $object = $filter_module->new();
106
            $filter_module->initialize($param);
108
            $filter_module->initialize($param);
107
            push @filters, $object;
109
            push @filters, $object;
108
        }
110
        }
109
    }
111
    }
110
112
111
    my $self = $class->SUPER::new( { schema => $schema,
113
    my $self = $class->SUPER::new(
112
                                     filters => \@filters,
114
        {
113
                                     options => $options });
115
            schema  => $schema,
116
            filters => \@filters,
117
            options => $options
118
        }
119
    );
114
    bless $self, $class;
120
    bless $self, $class;
115
    return $self;
121
    return $self;
116
}
122
}
Lines 122-129 sub new { Link Here
122
Bind a normalizer to a particular record.
128
Bind a normalizer to a particular record.
123
129
124
=cut
130
=cut
131
125
sub bind {
132
sub bind {
126
    my $self = shift;
133
    my $self   = shift;
127
    my $record = shift;
134
    my $record = shift;
128
135
129
    $self->{record} = $record;
136
    $self->{record} = $record;
Lines 140-145 Note that $record may be either a scalar or an arrayref, and the Link Here
140
return value will be of the same type.
147
return value will be of the same type.
141
148
142
=cut
149
=cut
150
143
sub process {
151
sub process {
144
    my $self = shift;
152
    my $self = shift;
145
    my $record = shift || $self->record;
153
    my $record = shift || $self->record;
Lines 148-154 sub process { Link Here
148
156
149
    my $newrecord = $record;
157
    my $newrecord = $record;
150
158
151
    foreach my $filterobj (@{$self->filters}) {
159
    foreach my $filterobj ( @{ $self->filters } ) {
152
        next unless $filterobj;
160
        next unless $filterobj;
153
        $newrecord = $filterobj->filter($newrecord);
161
        $newrecord = $filterobj->filter($newrecord);
154
    }
162
    }
Lines 159-165 sub process { Link Here
159
sub DESTROY {
167
sub DESTROY {
160
    my $self = shift;
168
    my $self = shift;
161
169
162
    foreach my $filterobj (@{$self->filters}) {
170
    foreach my $filterobj ( @{ $self->filters } ) {
163
        $filterobj->destroy();
171
        $filterobj->destroy();
164
    }
172
    }
165
}
173
}
Lines 172-182 Get a list of available filters. Optionally specify the metadata schema. Link Here
172
At present only MARC is supported as a schema.
180
At present only MARC is supported as a schema.
173
181
174
=cut
182
=cut
183
175
sub AvailableFilters {
184
sub AvailableFilters {
176
    my $schema = pop || '';
185
    my $schema = pop || '';
177
    my $path = 'Koha::Filter';
186
    my $path = 'Koha::Filter';
178
    $path .= "::$schema" if ($schema eq 'MARC');
187
    $path .= "::$schema" if ( $schema eq 'MARC' );
179
    my $finder = Module::Pluggable::Object->new(search_path => $path);
188
    my $finder = Module::Pluggable::Object->new( search_path => $path );
180
    return $finder->plugins;
189
    return $finder->plugins;
181
}
190
}
182
191
(-)a/Koha/RecordProcessor/Base.pm (-13 / +13 lines)
Lines 58-74 clone it I<prior> to passing it off to the RecordProcessor. Link Here
58
58
59
=cut
59
=cut
60
60
61
use strict;
61
use Modern::Perl;
62
use warnings;
62
use Class::Accessor "antlers";
63
63
64
use base qw(Class::Accessor);
64
has name    => ( is => "ro" );
65
has version => ( is => "ro" );
66
has params  => ( is => "rw" );
65
67
66
__PACKAGE__->mk_ro_accessors(qw( name version ));
68
our $NAME    = 'Base';
67
__PACKAGE__->mk_accessors(qw( params ));
68
our $NAME = 'Base';
69
our $VERSION = '1.0';
69
our $VERSION = '1.0';
70
70
71
72
=head2 new
71
=head2 new
73
72
74
    my $filter = Koha::RecordProcessor::Base->new;
73
    my $filter = Koha::RecordProcessor::Base->new;
Lines 76-92 our $VERSION = '1.0'; Link Here
76
Create a new filter;
75
Create a new filter;
77
76
78
=cut
77
=cut
78
79
sub new {
79
sub new {
80
    my $class = shift;
80
    my $class = shift;
81
81
82
    my $self = $class->SUPER::new( { });#name => $class->NAME,
82
    my $self = $class->SUPER::new( {} );
83
                                     #version => $class->VERSION });
84
83
85
    bless $self, $class;
84
    bless $self, $class;
86
    return $self;
85
    return $self;
87
}
86
}
88
87
89
90
=head2 initialize
88
=head2 initialize
91
89
92
    $filter->initalize(%params);
90
    $filter->initalize(%params);
Lines 94-101 sub new { Link Here
94
Initialize a filter using the specified parameters.
92
Initialize a filter using the specified parameters.
95
93
96
=cut
94
=cut
95
97
sub initialize {
96
sub initialize {
98
    my $self = shift;
97
    my $self   = shift;
99
    my $params = shift;
98
    my $params = shift;
100
99
101
    #$self->params = $params;
100
    #$self->params = $params;
Lines 103-109 sub initialize { Link Here
103
    return $self;
102
    return $self;
104
}
103
}
105
104
106
107
=head2 destroy
105
=head2 destroy
108
106
109
    $filter->destroy();
107
    $filter->destroy();
Lines 111-116 sub initialize { Link Here
111
Destroy the filter.
109
Destroy the filter.
112
110
113
=cut
111
=cut
112
114
sub destroy {
113
sub destroy {
115
    my $self = shift;
114
    my $self = shift;
116
    return;
115
    return;
Lines 124-131 sub destroy { Link Here
124
Filter the specified record(s) and return the result.
123
Filter the specified record(s) and return the result.
125
124
126
=cut
125
=cut
126
127
sub filter {
127
sub filter {
128
    my $self = shift;
128
    my $self   = shift;
129
    my $record = shift;
129
    my $record = shift;
130
    return $record;
130
    return $record;
131
}
131
}
(-)a/t/AuthoritiesMarc.t (-5 / +26 lines)
Lines 1-14 Link Here
1
#!/usr/bin/perl
1
#!/usr/bin/perl
2
#
2
#
3
# This Koha test module is a stub!  
3
# This Koha test module is a stub!
4
# Add more tests here!!!
4
# Add more tests here!!!
5
5
6
use strict;
6
use Modern::Perl;
7
use warnings;
8
7
9
use Test::More tests => 1;
8
use C4::Context;
9
use Test::More tests => 4;
10
10
11
BEGIN {
11
BEGIN {
12
        use_ok('C4::AuthoritiesMarc');
12
    use_ok('C4::AuthoritiesMarc');
13
}
13
}
14
14
15
SKIP:
16
{
17
    my $authority;
18
    my $dbh = C4::Context->dbh;
19
    my $sth = $dbh->prepare("SELECT authid FROM auth_header LIMIT 1;");
20
    $sth->execute();
21
22
    my $authid;
23
    for my $row ( $sth->fetchrow_hashref ) {
24
        $authid = $row->{'authid'};
25
    }
26
    skip 'No authorities', 4 unless $authid;
27
    $authority = GetAuthority($authid);
28
29
    is( ref($authority), 'MARC::Record', 'Retrieved valid MARC::Record' );
30
31
    is( $authority->field('001')->data(), $authid, 'Retrieved correct record' );
32
33
    $authority = GetAuthority('alphabetsoup');
34
    is( $authority, undef, 'No invalid record is retrieved' );
35
}
(-)a/t/RecordProcessor.t (-24 / +37 lines)
Lines 25-80 use MARC::Record; Link Here
25
use Test::More;
25
use Test::More;
26
26
27
BEGIN {
27
BEGIN {
28
        use_ok('Koha::RecordProcessor');
28
    use_ok('Koha::RecordProcessor');
29
}
29
}
30
30
31
my $isbn = '0590353403';
31
my $isbn        = '0590353403';
32
my $title = 'Foundation';
32
my $title       = 'Foundation';
33
my $marc_record=MARC::Record->new;
33
my $marc_record = MARC::Record->new;
34
my $field = MARC::Field->new('020','','','a' => $isbn);
34
my $field       = MARC::Field->new( '020', '', '', 'a' => $isbn );
35
$marc_record->append_fields($field);
35
$marc_record->append_fields($field);
36
$field = MARC::Field->new('245','','','a' => $title);
36
$field = MARC::Field->new( '245', '', '', 'a' => $title );
37
$marc_record->append_fields($field);
37
$marc_record->append_fields($field);
38
38
39
40
my $filterdir = File::Spec->rel2abs('Koha/Filter') . '/MARC';
39
my $filterdir = File::Spec->rel2abs('Koha/Filter') . '/MARC';
41
40
42
opendir(my $dh, $filterdir);
41
opendir( my $dh, $filterdir );
43
my @installed_filters = map { ( /\.pm$/ && -f "$filterdir/$_" && s/\.pm$// ) ? "Koha::Filters::MARC::$_" : () } readdir($dh);
42
my @installed_filters = map {
43
    ( /\.pm$/ && -f "$filterdir/$_" && s/\.pm$// )
44
      ? "Koha::Filters::MARC::$_"
45
      : ()
46
} readdir($dh);
44
my @available_filters = Koha::RecordProcessor::AvailableFilters();
47
my @available_filters = Koha::RecordProcessor::AvailableFilters();
45
48
46
foreach my $filter (@installed_filters) {
49
foreach my $filter (@installed_filters) {
47
    ok(grep($filter, @available_filters), "Found filter $filter");
50
    ok( grep( $filter, @available_filters ), "Found filter $filter" );
48
}
51
}
49
52
50
my $marc_filters = grep (/MARC/, @available_filters);
53
my $marc_filters = grep ( /MARC/, @available_filters );
51
is(scalar Koha::RecordProcessor::AvailableFilters('MARC'), $marc_filters, 'Retrieved list of MARC filters');
54
is( scalar Koha::RecordProcessor::AvailableFilters('MARC'),
55
    $marc_filters, 'Retrieved list of MARC filters' );
52
56
53
my $processor = Koha::RecordProcessor->new( { filters => ( 'ABCD::EFGH::IJKL' ) } );
57
my $processor =
58
  Koha::RecordProcessor->new( { filters => ('ABCD::EFGH::IJKL') } );
54
59
55
is(ref($processor), 'Koha::RecordProcessor', 'Created record processor with invalid filter');
60
is( ref($processor), 'Koha::RecordProcessor',
61
    'Created record processor with invalid filter' );
56
62
57
is($processor->process($marc_record), $marc_record, 'Process record with empty processor');
63
is( $processor->process($marc_record),
64
    $marc_record, 'Process record with empty processor' );
58
65
59
$processor = Koha::RecordProcessor->new( { filters => ( 'Null' ) } );
66
$processor = Koha::RecordProcessor->new( { filters => ('Null') } );
60
is(ref($processor->filters->[0]), 'Koha::Filter::MARC::Null', 'Created record processor with implicitly scoped Null filter');
67
is( ref( $processor->filters->[0] ),
68
    'Koha::Filter::MARC::Null',
69
    'Created record processor with implicitly scoped Null filter' );
61
70
62
$processor = Koha::RecordProcessor->new( { filters => ( 'Koha::Filter::MARC::Null' ) } );
71
$processor =
63
is(ref($processor->filters->[0]), 'Koha::Filter::MARC::Null', 'Created record processor with explicitly scoped Null filter');
72
  Koha::RecordProcessor->new( { filters => ('Koha::Filter::MARC::Null') } );
73
is( ref( $processor->filters->[0] ),
74
    'Koha::Filter::MARC::Null',
75
    'Created record processor with explicitly scoped Null filter' );
64
76
65
is($processor->process($marc_record), $marc_record, 'Process record');
77
is( $processor->process($marc_record), $marc_record, 'Process record' );
66
78
67
$processor->bind($marc_record);
79
$processor->bind($marc_record);
68
80
69
is($processor->record, $marc_record, 'Bound record to processor');
81
is( $processor->record, $marc_record, 'Bound record to processor' );
70
82
71
is($processor->process(), $marc_record, 'Filter bound record');
83
is( $processor->process(), $marc_record, 'Filter bound record' );
72
84
73
eval {
85
eval {
74
    $processor = Koha::RecordProcessor->new( { filters => ( 'Koha::Filter::MARC::Null' ) } );
86
    $processor =
87
      Koha::RecordProcessor->new( { filters => ('Koha::Filter::MARC::Null') } );
75
    undef $processor;
88
    undef $processor;
76
};
89
};
77
90
78
ok(!$@, 'Destroyed processor successfully');
91
ok( !$@, 'Destroyed processor successfully' );
79
92
80
done_testing();
93
done_testing();
(-)a/t/RecordProcessor_EmbedSeeFromHeadings.t (+127 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2012 C & P Bibliography Services
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 2 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
use DBI;
22
use File::Spec;
23
use MARC::Record;
24
use MARC::File::XML;
25
26
use Test::More tests => 9;
27
use Test::MockModule;
28
29
use C4::Context;
30
31
BEGIN {
32
    use_ok('Koha::RecordProcessor');
33
}
34
35
# Mock the call to create a database handler
36
my $module = new Test::MockModule('C4::Context');
37
$module->mock(
38
    '_new_dbh',
39
    sub {
40
        my $dbh = DBI->connect( 'DBI:Mock:', '', '' )
41
          || die "Cannot create handle: $DBI::errstr\n";
42
        return $dbh;
43
    }
44
);
45
$module->mock(
46
    'preference',
47
    sub {
48
        return 'MARC21' if ( pop @_ eq 'marcflavour' );
49
        return 0;
50
    }
51
);
52
53
# Mock data
54
my $auth = MARC::Record->new;
55
$auth->add_fields(
56
    [ '001', '1234' ],
57
    [ '150', ' ', ' ', a => 'Cooking' ],
58
    [ '450', ' ', ' ', a => 'Cookery' ],
59
);
60
61
my $mockauthority =
62
  [ [ 'authtypecode', 'marcxml' ], [ 'TOPIC', $auth->as_xml_record() ], ];
63
64
my $dbh = C4::Context->dbh();    # since we mocked _new_dbh we get a mock handle
65
66
my $bib = MARC::Record->new;
67
$bib->add_fields(
68
    [ '245', '0', '4', a => 'The Ifrane cookbook' ],
69
    [ '650', ' ', ' ', a => 'Cooking', 9 => '1234' ]
70
);
71
72
my $resultbib = MARC::Record->new;
73
$resultbib->add_fields(
74
    [ '245', '0', '4', a => 'The Ifrane cookbook' ],
75
    [ '650', ' ', ' ', a => 'Cooking', 9 => '1234' ],
76
    [ '650', 'z', ' ', a => 'Cookery' ]
77
);
78
79
my $processor =
80
  Koha::RecordProcessor->new( { filters => ('EmbedSeeFromHeadings') } );
81
is( ref($processor), 'Koha::RecordProcessor', 'Created record processor' );
82
is(
83
    ref( $processor->filters->[0] ),
84
    'Koha::Filter::MARC::EmbedSeeFromHeadings',
85
    'Loaded EmbedSeeFromHeadings filter'
86
);
87
88
$dbh->{mock_add_resultset} = $mockauthority;
89
90
my $result = $processor->process(undef);
91
92
is( $result, undef, "Don't flip out when asked to process nothing" );
93
94
$result = $processor->process($bib);
95
96
my $history = $dbh->{mock_all_history};
97
is( scalar( @{$history} ), 1, 'Correct number of statements executed' );
98
$dbh->{mock_clear_history} = 1;
99
100
is_deeply( $result, $resultbib, 'Inserted see-from heading to record' );
101
102
my @bibs;
103
$bib = MARC::Record->new;
104
$bib->add_fields(
105
    [ '245', '0', '4', a => 'The Ifrane cookbook' ],
106
    [ '650', ' ', ' ', a => 'Cooking', 9 => '1234' ]
107
);
108
push @bibs, $bib;
109
$bib = MARC::Record->new;
110
$bib->add_fields(
111
    [ '245', '0', '2', a => 'A story of great tragedy, and fish' ],
112
    [ '650', ' ', ' ', a => 'Fish', 9 => '5432' ] );
113
push @bibs, $bib;
114
my @resultbibs;
115
push @resultbibs, $resultbib;
116
push @resultbibs, $bib;
117
118
$dbh->{mock_add_resultset} = $mockauthority;
119
120
$result = $processor->process( \@bibs );
121
122
is( scalar(@$result), 2, 'Processed two records' );
123
124
$history = $dbh->{mock_all_history};
125
is( scalar( @{$history} ), 2, 'Correct number of statements executed' );
126
127
is_deeply( $result, \@resultbibs, 'Handled both records correctly' );
(-)a/t/db_dependent/Koha_Authority.t (-20 / +20 lines)
Lines 17-44 Link Here
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
19
20
use strict;
20
use Modern::Perl;
21
use warnings;
22
21
23
use C4::Context;
22
use C4::Context;
24
use Test::More;
23
use Test::More tests => 7;
25
24
26
BEGIN {
25
BEGIN {
27
        use_ok('Koha::Authority');
26
    use_ok('Koha::DataObject::Authority');
28
}
27
}
29
28
30
my $record = MARC::Record->new;
29
my $record = MARC::Record->new;
31
30
32
$record->add_fields(
31
$record->add_fields(
33
        [ '001', '1234' ],
32
    [ '001', '1234' ],
34
        [ '150', ' ', ' ', a => 'Cooking' ],
33
    [ '150', ' ', ' ', a => 'Cooking' ],
35
        [ '450', ' ', ' ', a => 'Cookery' ],
34
    [ '450', ' ', ' ', a => 'Cookery' ],
36
        );
35
);
37
my $authority = Koha::Authority->new($record);
36
my $authority = Koha::DataObject::Authority->new( { marcrecord => $record } );
38
37
39
is(ref($authority), 'Koha::Authority', 'Created valid Koha::Authority object');
38
is( ref($authority), 'Koha::DataObject::Authority',
39
    'Created valid Koha::DataObject::Authority object' );
40
40
41
is_deeply($authority->record, $record, 'Saved record');
41
is_deeply( $authority->marcrecord, $record, 'Saved record' );
42
42
43
SKIP:
43
SKIP:
44
{
44
{
Lines 47-66 SKIP: Link Here
47
    $sth->execute();
47
    $sth->execute();
48
48
49
    my $authid;
49
    my $authid;
50
    for my $row ($sth->fetchrow_hashref) {
50
    for my $row ( $sth->fetchrow_hashref ) {
51
        $authid = $row->{'authid'};
51
        $authid = $row->{'authid'};
52
    }
52
    }
53
    skip 'No authorities', 3 unless $authid;
53
    skip 'No authorities', 3 unless $authid;
54
    $authority = Koha::Authority->get_from_authid($authid);
54
    $authority = Koha::DataObject::Authority->new( { authid => $authid } );
55
55
56
    is(ref($authority), 'Koha::Authority', 'Retrieved valid Koha::Authority object');
56
    is( ref($authority), 'Koha::DataObject::Authority',
57
        'Retrieved valid Koha::DataObject::Authority object' );
57
58
58
    is($authority->authid, $authid, 'Object authid is correct');
59
    is( $authority->authid, $authid, 'Object authid is correct' );
59
60
60
    is($authority->record->field('001')->data(), $authid, 'Retrieved correct record');
61
    is( $authority->marcrecord->field('001')->data(),
61
62
        $authid, 'Retrieved correct record' );
62
    $authority = Koha::Authority->get_from_authid('alphabetsoup');
63
    is($authority, undef, 'No invalid record is retrieved');
64
}
63
}
65
64
66
done_testing();
65
$authority = Koha::DataObject::Authority->new( { authid => 'alphabetsoup' } );
66
is( $authority, undef, 'No invalid record is retrieved' );
(-)a/t/db_dependent/RecordProcessor_EmbedSeeFromHeadings.t (-67 lines)
Lines 1-66 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2012 C & P Bibliography Services
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 2 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 strict;
21
use warnings;
22
use File::Spec;
23
use MARC::Record;
24
use Koha::Authority;
25
26
use Test::More;
27
use Test::MockModule;
28
29
BEGIN {
30
        use_ok('Koha::RecordProcessor');
31
}
32
33
my $module = new Test::MockModule('MARC::Record');
34
$module->mock('new_from_xml', sub {
35
    my $record = MARC::Record->new;
36
37
    $record->add_fields(
38
        [ '001', '1234' ],
39
        [ '150', ' ', ' ', a => 'Cooking' ],
40
        [ '450', ' ', ' ', a => 'Cookery' ],
41
        );
42
43
    return $record;
44
});
45
46
my $bib = MARC::Record->new;
47
$bib->add_fields(
48
    [ '245', '0', '4', a => 'The Ifrane cookbook' ],
49
    [ '650', ' ', ' ', a => 'Cooking', 9 => '1234' ]
50
    );
51
52
my $resultbib = MARC::Record->new;
53
$resultbib->add_fields(
54
    [ '245', '0', '4', a => 'The Ifrane cookbook' ],
55
    [ '650', ' ', ' ', a => 'Cooking', 9 => '1234' ],
56
    [ '650', 'z', ' ', a => 'Cookery' ]
57
    );
58
59
my $processor = Koha::RecordProcessor->new( { filters => ( 'EmbedSeeFromHeadings' ) } );
60
is(ref($processor), 'Koha::RecordProcessor', 'Created record processor');
61
62
my $result = $processor->process($bib);
63
64
is_deeply($result, $resultbib, 'Inserted see-from heading to record');
65
66
done_testing();
67
- 

Return to bug 7417