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

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

Return to bug 7417