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
129
130
131
132
133
134
135
136
137
|
#!/usr/bin/perl
# The following example is an expanded version of "addlocal.pl" that
# checks and fixes existing records in addition to processing new ones.
# It first looks for a call number subfield 'h' of the 852 field (#852.h).
# If missing, it then checks #900.a and #999.f for the data. It puts the
# call number found into all of these locations including any repeated
# fields. It will create the locations if necessary.
use MARC 0.95;
my $infile = "specials.001";
my $outfile = "output.003";
my $outtext = "output3.txt";
my $outtext2 = "output4.txt";
unlink $outfile, $outtext, $outtext2;
sub fix_update {
my $subfield = shift;
my $value = shift;
my @f = ();
my $ff;
my $altered = 0;
my $fixed = 0;
while (@_) {
last unless defined ($ff = shift);
if ($ff eq "\036") {
unless ($fixed) {
push @f, $subfield, $value;
$altered++;
}
push @f, $ff;
$fixed = 0;
next;
}
push @f, $ff;
unless ($subfield eq $ff) {
push @f, shift;
next;
}
last unless defined ($ff = shift);
push @f, $value;
$fixed++;
if ($value ne $ff) { $altered++; }
}
return ($altered,@f);
}
my $loc852 = {record=>1, field=>'852', ordered=>'y'};
my $loc900 = {record=>1, field=>'900', ordered=>'y'};
my $loc999 = {record=>1, field=>'999', ordered=>'n'};
$x = MARC->new;
$x->openmarc({file=>$infile,'format'=>"usmarc"}) || die;
# We process records one at a time for this operation. Multiple 852 fields
# are legal (for multiple copies) - the 'h' subfield should be the same.
# But a few percent of incoming materials do not include this subfield.
while ($x->nextmarc(1)) {
my $from999 = "";
my $from900 = "";
my ($callno) = $x->getvalue($loc852,'subfield','h');
my $from852 = (1 == scalar $x->getvalue($loc852)) ? $callno : "";
unless ($callno) {
# "" and '0' are not legal call numbers
$callno = "";
($from900) = $x->getvalue($loc900,'subfield','a');
if ($from900) {
$callno = $from900;
}
else {
($from999) = $x->getvalue($loc999,'subfield','f');
if ($from999) {
$callno = $from999;
}
}
}
my $change = 0;
my ($found) = $x->searchmarc($loc999);
if (defined $found) {
my @m999 = $x->getupdate($loc999);
my @f999 = fix_update('f', $callno, @m999);
if (shift @f999) {
$change++;
$x->updaterecord ($loc999, @f999) || warn "999 update failed\n";
}
}
else {
$x->addfield($loc999,'i1',' ','i2',' ',
'c','wL70','d','AR Clinton PL','f',"$callno");
$change++;
}
($found) = $x->searchmarc($loc900);
if (defined $found) {
my @m900 = $x->getupdate($loc900);
my @f900 = fix_update('a', $callno, @m900);
if (shift @f900) {
$change++;
$x->updaterecord ($loc900, @f900) || warn "900 update failed\n";
}
}
else {
$x->addfield($loc900,'i1',' ','i2',' ','a',"$callno");
$change++;
}
if ($callno && not $from852) {
($found) = $x->searchmarc($loc852);
if (defined $found) {
my @m852 = $x->getupdate($loc852);
my @f852 = fix_update('h', $callno, @m852);
if (shift @f852) {
$change++;
$x->updaterecord ($loc852, @f852) || warn "852 update failed\n";
}
}
else {
$x->addfield($loc852,'i1','1','i2',' ','h',"$callno");
$change++;
}
}
$x->output({file=>">>$outfile",'format'=>"usmarc"});
$x->output({file=>">>$outtext",'format'=>"ascii"}) unless $callno;
$x->output({file=>">>$outtext2",'format'=>"ascii"}) if $change;
$x->deletemarc(); #empty the object for reading in another
}
# We write all the records to the output file in MARC format. Even the
# incomplete ones at least have added the fixed data. The ascii output
# in $outtext gives the librarian both a list of records requiring manual
# call number assignment and all the Title, Author, Publication and
# related data needed to assign location based on standard references.
# For checking, we write all the modified records to $outtext2.
|
