On Tue, Jul 08, 2003 at 02:57:27PM -0400, Michael Bowden wrote:
> I have a question about extracting the subfields from the 650 in the
> proper order. Basically, I have a number of records that contain 650s
> with $x Periodicals. I need to modify the subfield from x to v. The
> problem I am running into is that I don't know how to keep the subfields
> in the proper order. I have some records that have 650 $a $x $y $x and
> others that have 650 $a $x $x. It is this last $x that I need to change
> to a $v. Can someone offer some advise on modifying subfields that need
> to stay in the order found in the record?
Since there haven't been any other responses yet I'll take a stab. I
recommend you take a look at using MARC::Field::subfields() and
MARC::Field::replace_with().
MARC::Field::subfields() will return a list of array refs, where each
array ref is a subfield code/data pair. It will be useful for getting at all
the subfields, and manipulating the last subfield x.
MARC::Field::replace_with() will allow you to build up a new field
(based on the old field, possibly with a shiny new subfield v), and then
replace the old field with the new one.
#!/usr/bin/perl
use MARC::Batch;
use Data::Dumper;
my $file = shift;
my $batch = MARC::Batch->new( 'USMARC', $file );
while ( my $record = $batch->next() ) {
# go through all 650 fields in the record
foreach my $subject ( $record->field( '650' ) ) {
# extract subfields as an array of array refs
my @subfields = $subject->subfields();
# setup an array to store our new subfields
my @newSubfields = ();
# a flag to indicate that we found an subfield x
my $foundX = 0;
# use pop() to read the subfields backwards
while ( my $subfield = pop( @subfields ) ) {
# for convenience pull out the subfield code and data from
# the array ref
my ($code,$data) = @$subfield;
# if the subfield code is 'x' and we haven't already found one
if ( $code eq 'x' and ! $foundX ) {
# change the x to a v
$code = 'v';
# set flag so we know not to translate any more subfield x
$foundX = 1;
}
# add our (potentially changed) subfield data to our new
# subfield data array. note: unshift will put them back
# in the right order, but push would put them back in
# reverse, since we are reading them in reverse.
unshift( @newSubfields, $code, $data );
}
# if we did find a subfield x then create a new field using our new
# subfield data, and replace the old one with the new one
if ( $foundX ) {
my $newSubject = MARC::Field->new(
$subject->tag(),
$subject->indicator(1),
$subject->indicator(2),
@newSubfields
);
$subject->replace_with( $newSubject );
}
}
# output the potentially changed record as MARC
print $record->as_usmarc();
}
Not too long, considering the amount of comments :-) If you saved the
script as a file called xtov you would run it like a Unix filter.
xtov file.dat > new.dat
//Ed
