ادارہ پاکستان براےء آزاد مصدر

Pakistan Open Source Organization


MARC / PERL: Koha Integrated Library System

MARC Tutorial

Updating subject subfield x to subfield v

As a somewhat more complicated example, you may find yourself wanting to update the last subfield x in a 650 field to be a subfield v instead. With the MARC::Field subfields()and replace_with()methods along with some fancy footwork this can be done relatively easily.

1 ## Example U9
2
3 use MARC::Batch;
4
5 my $file = shift;
6
7 my $batch = MARC::Batch->new('USMARC', $file);
8 while ( my $record = $batch->next() ) {
9
10 # go through all 6XX fields in the record.
11 foreach my $subject ( $record->field( '6..' ) ) {
12
13 # extract subfields as an array of array refs.
14 my @subfields = $subject->subfields();
15
16 # setup an array to store our new field.
17 my @newSubfields = ();
18
19 # a flag to indicate that we found an subfield x.
20 my $foundX = 0;
21
22 # use pop() to read the subfields backwards.
23 while ( my $subfield = pop( @subfields ) ) {
24
25 # for convenience, pull out the subfield
26 # code and data from the array ref.
27 my ($code,$data) = @$subfield;
28
29 # if the subfield code is 'x' and
30 # we haven't already found one...
31 if ( $code eq 'x' and ! $foundX ) {
32
33 # change to a v.
34 $code = 'v';
35
36 # set flag so we know not to
37 # translate any more subfield x.
38 $foundX = 1;
39
40 }
41
42 # add our (potentially changed) subfield
43 # data to our new subfield data array.
44 unshift( @newSubfields, $code, $data );
45
46 }
47
48 # if we did find a subfield x, then create a new field using our
49 # new subfield data, and replace the old one with the new one.
50 if ( $foundX ) {
51 my $newSubject = MARC::Field->new(
52 $subject->tag(),
53 $subject->indicator(1),
54 $subject->indicator(2),
55 @newSubfields
56 );
57 $subject->replace_with( $newSubject );
58 }
59
60 }
61
62 # output the potentially changed record as MARC.
63 print $record->as_usmarc();
64
65 }