1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!perl
use strict;
use warnings;
use File::Spec;
use Test::More tests=>40;
BEGIN { use_ok( 'MARC::File::USMARC' ); }
BEGIN { use_ok( 'MARC::Lint' ); }
FROM_FILE: {
my @expected = ( (undef) x 9, [ q{100: Indicator 1 must be 0, 1 or 3 but it's "2"} ], [ q{007: Subfields are not allowed in fields lower than 010} ] );
my $lint = new MARC::Lint;
isa_ok( $lint, 'MARC::Lint' );
my $filename = File::Spec->catfile( 't', 'camel.usmarc');
my $file = MARC::File::USMARC->in( $filename );
while ( my $marc = $file->next() ) {
isa_ok( $marc, 'MARC::Record' );
my $title = $marc->title;
$lint->check_record( $marc );
my $expected = shift @expected;
my @warnings = $lint->warnings;
if ( $expected ) {
ok( eq_array( \@warnings, $expected ), "Warnings match on $title" );
} else {
is( scalar @warnings, 0, "No warnings on $title" );
}
} # while
is( scalar @expected, 0, "All expected messages have been exhausted." );
}
FROM_TEXT: {
my $marc = MARC::Record->new();
isa_ok( $marc, 'MARC::Record', 'MARC record' );
$marc->leader("00000nam 22002538a 4500"); # The ????? represents meaningless digits at this point
my $nfields = $marc->add_fields(
['041', "0", "",
a => 'end',
a => 'fren',
],
['043', "", "",
a => 'n-us-pn',
],
['082', "0", "4",
a => '005.13/3',
R => 'all', #typo 'R' for 'W' and missing 'b' subfield
2 => '21'
],
['082', "1", "4",
a => '005.13',
b => 'Wall',
2 => '14'
],
[100, "1","4",
a => "Wall, Larry",
],
[110, "1","",
a => "O'Reilly & Associates.",
],
[245, "9","0",
a => "Programming Perl / ",
a => "Big Book of Perl /",
c => "Larry Wall, Tom Christiansen & Jon Orwant.",
],
[250, "", "",
a => "3rd ed.",
],
[250, "", "",
a => "3rd ed.",
],
[260, "", "",
a => "Cambridge, Mass. : ",
b => "O'Reilly, ",
r => "2000.",
],
[590, "4","",
a => "Personally signed by Larry.",
],
[650, "","0",
a => "Perl (Computer program language)",
0 => "(DLC)sh 95010633",
],
[856, "4","3",
u => "http://www.perl.com/",
],
[886, "0", "",
4 => "Some foreign thing",
q => "Another foreign thing",
],
);
is( $nfields, 14, "All the fields added OK" );
my @expected = (
q{1XX: Only one 1XX tag is allowed, but I found 2 of them.},
q{041: Subfield _a, end (end), is not valid.},
q{041: Subfield _a must be evenly divisible by 3 or exactly three characters if ind2 is not 7, (fren).},
q{043: Subfield _a, n-us-pn, is not valid.},
q{082: Subfield _R is not allowed.},
q{100: Indicator 2 must be blank but it's "4"},
q{245: Indicator 1 must be 0 or 1 but it's "9"},
q{245: Subfield _a is not repeatable.},
# q{250: Field is not repeatable.}, #obsolete now that 250 is repeatable
q{260: Subfield _r is not allowed.},
q{856: Indicator 2 must be blank, 0, 1, 2 or 8 but it's "3"},
);
my $lint = new MARC::Lint;
isa_ok( $lint, 'MARC::Lint' );
$lint->check_record( $marc );
my @warnings = $lint->warnings;
while ( @warnings ) {
my $expected = shift @expected;
my $actual = shift @warnings;
is( $actual, $expected, "Checking expected messages" );
}
is( scalar @expected, 0, "All expected messages exhausted." );
}
|
