7721a7b8d2
perlcritic -5 failed. Attempt to clean up to a higher level: -- use English to address use of $@ variable -- perltidy on the code -- substitute q{} for '' -- expand out single line hacky goodness (... s/\.pm$//) to more code -- remove parenthesis on functions that don't need it -- add x, s, and m as needed to regexps -- change double quotes to single quotes where no variable involved -- tweaked eval destroy test to check return value and use $EVAL_ERROR -- renamed $processor to $record_processor in the subtest to avoid lexical warnings TEST PLAN --------- $ perlcritic -5 t/RecordProcessor.t Don't modify $_ in list functions at line 43, column 25. See page 114 of PBP. (Severity: 5) $ perlcritic -2 t/RecordProcessor.t No package-scoped "$VERSION" variable found at line 1, column 1. See page 404 of PBP. (Severity: 2) Quotes used with a string containing no non-whitespace characters at line 34, column 36. See page 53 of PBP. (Severity: 2) Quotes used with a string containing no non-whitespace characters at line 34, column 39. See page 53 of PBP. (Severity: 2) Quotes used with a string containing no non-whitespace characters at line 36, column 33. See page 53 of PBP. (Severity: 2) Quotes used with a string containing no non-whitespace characters at line 36, column 36. See page 53 of PBP. (Severity: 2) Don't modify $_ in list functions at line 43, column 25. See page 114 of PBP. (Severity: 5) Regular expression without "/s" flag at line 43, column 33. See pages 240,241 of PBP. (Severity: 2) Regular expression without "/x" flag at line 43, column 33. See page 236 of PBP. (Severity: 3) Regular expression without "/m" flag at line 43, column 33. See page 237 of PBP. (Severity: 2) Regular expression without "/s" flag at line 43, column 66. See pages 240,241 of PBP. (Severity: 2) Regular expression without "/x" flag at line 43, column 66. See page 236 of PBP. (Severity: 3) Regular expression without "/m" flag at line 43, column 66. See page 237 of PBP. (Severity: 2) Expression form of "grep" at line 47, column 8. See page 169 of PBP. (Severity: 4) Expression form of "grep" at line 50, column 20. See page 169 of PBP. (Severity: 4) Regular expression without "/s" flag at line 50, column 26. See pages 240,241 of PBP. (Severity: 2) Regular expression without "/m" flag at line 50, column 26. See page 237 of PBP. (Severity: 2) Return value of eval not tested at line 73, column 1. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3) Magic punctuation variable $@ used at line 78, column 5. See page 79 of PBP. (Severity: 2) Reused variable name in lexical scope: $processor at line 84, column 5. Invent unique variable names. (Severity: 3) Subroutine "new" called using indirect syntax at line 87, column 18. See page 349 of PBP. (Severity: 4) Subroutine "new" called using indirect syntax at line 93, column 18. See page 349 of PBP. (Severity: 4) Quotes used with a string containing no non-whitespace characters at line 96, column 40. See page 53 of PBP. (Severity: 2) Subroutine "new" called using indirect syntax at line 99, column 18. See page 349 of PBP. (Severity: 4) Subroutine "new" called using indirect syntax at line 106, column 18. See page 349 of PBP. (Severity: 4) $ prove -v t/RecordProcessor.t t/RecordProcessor.t .. ok All tests successful. Files=1, Tests=13, 0 wallclock secs ( 0.01 usr 0.00 sys + 0.22 cusr 0.02 csys = 0.25 CPU) Result: PASS $ prove -v t/RecordProcessor.t ... $ git bz apply 15871 Repeat perlcritic level 2, and only $VERSION warning should exist. Retest with the prove. Run koha qa test tools. Signed-off-by: Hector Castro <hector.hecaxmmx@gmail.com> Works as advertised Signed-off-by: Jesse Maseto <jesse@bywatersolutions.com> Signed-off-by: Tomas Cohen Arazi <tomascohen@unc.edu.ar> I don't really care about perlcritic as long as it involves changing '' into qw{} (WTF?) Anyway, I'd do this kind of things as we go, for example, if we were adding more tests. In that case it would just be a followup for this, after you provided a patch for an enh/bugfix. Signed-off-by: Brendan A Gallagher <brendan@bywatersolutions.com>
152 lines
5.2 KiB
Perl
Executable file
152 lines
5.2 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
# Copyright 2012 C & P Bibliography Services
|
|
#
|
|
# 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, see <http://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
|
|
use File::Spec;
|
|
use MARC::Record;
|
|
use English qw( -no_match_vars );
|
|
use Test::More;
|
|
|
|
BEGIN {
|
|
use_ok('Koha::RecordProcessor');
|
|
}
|
|
|
|
my $isbn = '0590353403';
|
|
my $title = 'Foundation';
|
|
my $marc_record = MARC::Record->new;
|
|
my $field = MARC::Field->new( '020', q{}, q{}, 'a' => $isbn );
|
|
$marc_record->append_fields($field);
|
|
$field = MARC::Field->new( '245', q{}, q{}, 'a' => $title );
|
|
$marc_record->append_fields($field);
|
|
|
|
my $filterdir = File::Spec->rel2abs('Koha/Filter') . '/MARC';
|
|
|
|
my $dh;
|
|
opendir $dh, $filterdir;
|
|
my @installed_filters;
|
|
my @directory_entries = readdir $dh;
|
|
foreach my $entry (@directory_entries) {
|
|
if ( $entry =~ /[.]pm$/xsm && -f "$filterdir/$entry" ) {
|
|
my $filter_name = $entry;
|
|
$filter_name =~ s/[.]pm$//xsm;
|
|
push @installed_filters, $filter_name;
|
|
}
|
|
}
|
|
closedir $dh;
|
|
my @available_filters = Koha::RecordProcessor::AvailableFilters();
|
|
|
|
foreach my $filter (@installed_filters) {
|
|
ok( grep { /${filter}/xsm } @available_filters, "Found filter $filter" );
|
|
}
|
|
|
|
my $marc_filters = grep { /MARC/sm } @available_filters;
|
|
is( scalar Koha::RecordProcessor::AvailableFilters('MARC'),
|
|
$marc_filters, 'Retrieved list of MARC filters' );
|
|
|
|
my $processor =
|
|
Koha::RecordProcessor->new( { filters => ('ABCD::EFGH::IJKL') } );
|
|
|
|
is( ref($processor), 'Koha::RecordProcessor',
|
|
'Created record processor with invalid filter' );
|
|
|
|
is( $processor->process($marc_record),
|
|
$marc_record, 'Process record with empty processor' );
|
|
|
|
$processor = Koha::RecordProcessor->new( { filters => ('Null') } );
|
|
is( ref( $processor->filters->[0] ),
|
|
'Koha::Filter::MARC::Null',
|
|
'Created record processor with implicitly scoped Null filter' );
|
|
|
|
$processor =
|
|
Koha::RecordProcessor->new( { filters => ('Koha::Filter::MARC::Null') } );
|
|
is( ref( $processor->filters->[0] ),
|
|
'Koha::Filter::MARC::Null',
|
|
'Created record processor with explicitly scoped Null filter' );
|
|
|
|
is( $processor->process($marc_record), $marc_record, 'Process record' );
|
|
|
|
$processor->bind($marc_record);
|
|
|
|
is( $processor->record, $marc_record, 'Bound record to processor' );
|
|
|
|
is( $processor->process(), $marc_record, 'Filter bound record' );
|
|
|
|
my $destroy_test = eval {
|
|
$processor =
|
|
Koha::RecordProcessor->new( { filters => ('Koha::Filter::MARC::Null') } );
|
|
undef $processor;
|
|
return 1;
|
|
};
|
|
|
|
ok( !$EVAL_ERROR && $destroy_test == 1, 'Destroyed processor successfully' );
|
|
|
|
subtest 'new() tests' => sub {
|
|
|
|
plan tests => 14;
|
|
|
|
my $record_processor;
|
|
|
|
# Create a processor with a valid filter
|
|
$record_processor = Koha::RecordProcessor->new( { filters => 'Null' } );
|
|
is( ref($record_processor), 'Koha::RecordProcessor', 'Processor created' );
|
|
is( scalar @{ $record_processor->filters }, 1, 'One filter initialized' );
|
|
is( ref( $record_processor->filters->[0] ),
|
|
'Koha::Filter::MARC::Null', 'Correct filter initialized' );
|
|
|
|
# Create a processor with an invalid filter
|
|
$record_processor = Koha::RecordProcessor->new( { filters => 'Dummy' } );
|
|
is( ref($record_processor), 'Koha::RecordProcessor', 'Processor created' );
|
|
is( scalar @{ $record_processor->filters }, 0, 'No filter initialized' );
|
|
is( ref( $record_processor->filters->[0] ),
|
|
q{}, 'Make sure no filter initialized' );
|
|
|
|
# Create a processor with two valid filters
|
|
$record_processor = Koha::RecordProcessor->new(
|
|
{ filters => [ 'Null', 'EmbedSeeFromHeadings' ] } );
|
|
is( ref($record_processor), 'Koha::RecordProcessor', 'Processor created' );
|
|
is( scalar @{ $record_processor->filters }, 2, 'Two filters initialized' );
|
|
is(
|
|
ref( $record_processor->filters->[0] ),
|
|
'Koha::Filter::MARC::Null',
|
|
'Correct first filter initialized'
|
|
);
|
|
is(
|
|
ref( $record_processor->filters->[1] ),
|
|
'Koha::Filter::MARC::EmbedSeeFromHeadings',
|
|
'Correct second filter initialized'
|
|
);
|
|
|
|
# Create a processor with both valid and invalid filters.
|
|
# use hash reference for regression testing
|
|
my $parameters = {
|
|
filters => [ 'Null', 'Dummy' ],
|
|
options => { 'test' => 'true' }
|
|
};
|
|
$record_processor = Koha::RecordProcessor->new($parameters);
|
|
is( ref($record_processor), 'Koha::RecordProcessor', 'Processor created' );
|
|
is( scalar @{ $record_processor->filters }, 1, 'Invalid filter skipped' );
|
|
is( ref( $record_processor->filters->[0] ),
|
|
'Koha::Filter::MARC::Null', 'Correct filter initialized' );
|
|
|
|
my $filter_params = $record_processor->filters->[0]->params;
|
|
is_deeply( $filter_params, $parameters, 'Initialization parameters' );
|
|
};
|
|
|
|
done_testing();
|