use strict;
use XML::Twig;
-use Equinox::Migration::SubfieldMapper 1.003;
+use Equinox::Migration::SubfieldMapper 1.004;
=head1 NAME
=head1 VERSION
-Version 1.000
+Version 1.005
=cut
-our $VERSION = '1.000';
+our $VERSION = '1.005';
+
+my $dstore;
+my $sfmap;
+my @modlist = qw( multi ignoremulti bib required first concatenate );
+my %allmods = ();
+my $multis = {};
+my $reccount;
+my $verbose = 0;
=head1 SYNOPSIS
sub new {
my ($class, %args) = @_;
- my $self = bless { mods => { multi => {},
- bib => {},
- required => {},
- },
- data => { recs => undef, # X::T record objects
- rptr => 0, # next record pointer
- crec => undef, # parsed record storage
- },
+ $verbose = 1 if $args{verbose};
+
+ my $self = bless { multis => \$multis,
}, $class;
# initialize map and taglist
- die "Argument 'mapfile' must be specified\n" unless (defined $args{mapfile});
- my @mods = keys %{$self->{mods}};
- $self->{map} = Equinox::Migration::SubfieldMapper->new( file => $args{mapfile},
- mods => \@mods );
- $self->{data}{tags} = $self->{map}->tags;
+ die "Argument 'mapfile' must be specified\n" unless ($args{mapfile});
+ $sfmap = Equinox::Migration::SubfieldMapper->new( file => $args{mapfile},
+ mods => \@modlist );
+
+ # initialize datastore
+ $dstore = {};
+ $reccount = 0; # next record ptr
+ $dstore->{tags} = $sfmap->tags; # list of all tags
+ $self->{data} = $dstore;
# initialize twig
- die "Argument 'marcfile' must be specified\n" unless (defined $args{marcfile});
+ die "Argument 'marcfile' must be specified\n" unless ($args{marcfile});
if (-r $args{marcfile}) {
- $self->{twig} = XML::Twig->new;
- $self->{twig}->parsefile($args{marcfile});
- my @records = $self->{twig}->root->children;
- $self->{data}{recs} = \@records;
+ my $xmltwig = XML::Twig->new( twig_handlers => { record => \&parse_record } );
+ $xmltwig->parsefile( $args{marcfile} );
} else {
die "Can't open marc file: $!\n";
}
return $self;
}
-
=head2 parse_record
-Extracts data from the next record, per the mapping file. Returns a
-normalized datastructure (see L</format_record> for details) on
-success; returns 0 otherwise.
-
- while (my $rec = $m->parse_record) {
- # handle extracted record data
- }
+Extracts data from the next record, per the mapping file.
=cut
sub parse_record {
- my ($self) = @_;
-
- # get the next record and wipe current parsed record
- return 0 unless defined $self->{data}{recs}[ $self->{data}{rptr} ];
- my $record = $self->{data}{recs}[ $self->{data}{rptr} ];
- $self->{data}{crec} = { egid => undef, tags => undef };
+ my ($twig, $record) = @_;
+ my $crec = {}; # current record
my @fields = $record->children;
for my $f (@fields)
- { $self->process_field($f); $f->purge; }
+ { process_field($f, $crec) }
+
+ # fill in blank values if needed
+ for my $mappedtag ( @{ $sfmap->tags }) {
+ unless (exists $crec->{tmap}{$mappedtag}) {
+ push @{ $crec->{tags} }, {};
+ for my $mappedsub ( @{ $sfmap->subfields($mappedtag) } ) {
+ my $fieldname = $sfmap->field($mappedtag, $mappedsub);
+ my $mods = $sfmap->mods($fieldname);
+ next if $mods->{multi};
+ $crec->{tags}[-1]{uni}{$mappedsub} = '';
+ $crec->{tags}[-1]{multi} = undef;
+ $crec->{tags}[-1]{tag} = $mappedtag;
+ }
+ push @{ $crec->{tmap}{$mappedtag} }, $#{ $crec->{tags} };
+ }
+ }
# cleanup memory and increment pointer
$record->purge;
- $self->{data}{rptr}++;
+ $reccount++;
# check for required fields
- $self->check_required;
+ check_required($crec);
+ push @{ $dstore->{recs} }, $crec;
- return $self->{data}{crec};
+ print STDERR "$reccount\n"
+ if ($verbose and !($reccount % 1000));
}
sub process_field {
- my ($self, $field) = @_;
- my $map = $self->{map};
+ my ($field, $crec) = @_;
my $tag = $field->{'att'}->{'tag'};
- my $crec = $self->{data}{crec};
# leader
unless (defined $tag) {
$crec->{egid} = $sub->text;
return;
}
- if ($map->has($tag)) {
+ if ($sfmap->has($tag)) {
push @{$crec->{tags}}, { tag => $tag, uni => undef, multi => undef };
push @{$crec->{tmap}{$tag}}, (@{$crec->{tags}} - 1);
my @subs = $field->children('subfield');
for my $sub (@subs)
- { $self->process_subs($tag, $sub); $sub->purge; }
+ { process_subs($tag, $sub, $crec) }
# check map to ensure all declared tags and subs have a value
- my $mods = $map->mods($field);
- for my $mappedsub ( @{ $map->subfields($tag) } ) {
+ for my $mappedsub ( @{ $sfmap->subfields($tag) } ) {
+ my $fieldname = $sfmap->field($tag, $mappedsub);
+ my $mods = $sfmap->mods($fieldname);
next if $mods->{multi};
$crec->{tags}[-1]{uni}{$mappedsub} = ''
unless defined $crec->{tags}[-1]{uni}{$mappedsub};
}
- for my $mappedtag ( @{ $map->tags }) {
- $crec->{tmap}{$mappedtag} = undef
- unless defined $crec->{tmap}{$mappedtag};
- }
}
}
sub process_subs {
- my ($self, $tag, $sub) = @_;
- my $map = $self->{map};
+ my ($tag, $sub, $crec) = @_;
my $code = $sub->{'att'}->{'code'};
# handle unmapped tag/subs
- return unless ($map->has($tag, $code));
+ return unless ($sfmap->has($tag, $code));
- # fetch our datafield struct and fieldname
- my $dataf = $self->{data}{crec}{tags}[-1];
- my $field = $map->field($tag, $code);
- $self->{data}{crec}{names}{$tag}{$code} = $field;
+ # fetch our datafield struct and field and mods
+ my $dataf = $crec->{tags}[-1];
+ my $field = $sfmap->field($tag, $code);
+ my $sep = $sfmap->sep($field);
+ $allmods{$field} = $sfmap->mods($field) unless $allmods{$field};
+ my $mods = $allmods{$field};
# test filters
- for my $filter ( @{$map->filters($field)} ) {
+ for my $filter ( @{$sfmap->filters($field)} ) {
return if ($sub->text =~ /$filter/i);
}
+
# handle multi modifier
- if (my $mods = $map->mods($field)) {
- if ($mods->{multi}) {
- my $name = $tag . $code;
- push @{$dataf->{multi}{$name}}, $sub->text;
- return;
+ if ($mods->{multi}) {
+ $multis->{$tag}{$code} = 1;
+ if ($mods->{concatenate}) {
+ if (exists($dataf->{multi}{$code})) {
+ $dataf->{multi}{$code}[0] .= $sep . $sub->text;
+ } else {
+ push @{$dataf->{multi}{$code}}, $sub->text;
+ }
+ $multis->{$tag}{$code} = 1;
+ } else {
+ push @{$dataf->{multi}{$code}}, $sub->text;
+ }
+ return;
+ }
+
+
+ if ($mods->{concatenate}) {
+ if (exists($dataf->{uni}{$code})) {
+ $dataf->{uni}{$code} .= $sep . $sub->text;
+ } else {
+ $dataf->{uni}{$code} = $sub->text;
}
+ return;
}
# if this were a multi field, it would be handled already. make sure its a singleton
die "Multiple occurances of a non-multi field: $tag$code at rec ",
- ($self->{data}{rptr} + 1),"\n" if (defined $dataf->{uni}{$code});
+ ($reccount + 1),"\n" if (defined $dataf->{uni}{$code} and !$mods->{ignoremulti});
# everything seems okay
$dataf->{uni}{$code} = $sub->text;
sub check_required {
- my ($self) = @_;
- my $mods = $self->{map}->mods;
- my $crec = $self->{data}{crec};
+ my ($crec) = @_;
+ my $mods = $sfmap->mods;
for my $tag_id (keys %{$mods->{required}}) {
for my $code (@{$mods->{required}{$tag_id}}) {
$found = 1 if ($tag->{uni}{$code});
}
- die "Required mapping $tag_id$code not found in rec ",$self->{data}{rptr},"\n"
+ die "Required mapping $tag_id$code not found in rec ",$reccount,"\n"
unless ($found);
}
}
=cut
-sub recno { my ($self) = @_; return $self->{data}{rptr} }
+sub recno { my ($self) = @_; return $self->{data}{rcnt} }
=head2 name
-Returns mapped fieldname when pass a tag and code
+Returns mapped fieldname when passed a tag, and code
my $name = $m->name(999,'a');
=cut
-sub name { my ($self, $t, $c) = @_; return $self->{data}{crec}{names}{$t}{$c} };
+sub name { my ($self, $t, $c) = @_; return $sfmap->field($t, $c) }
+
+=head2 first_only
+
+Returns whether mapped fieldname is to be applied only to first
+item in a bib
+
+=cut
+
+sub first_only {
+ my ($self, $t, $c) = @_;
+ my $field = $sfmap->field($t, $c);
+ my $mods = $sfmap->mods($field);
+ return exists($mods->{first});
+}
+
+=head2 get_multis
+
+Returns hashref of C<{tag}{code}> for all mapped multi fields
+
+=cut
+
+sub get_multis {
+ my ($self) = @_;
+ return $multis;
+}
=head1 MODIFIERS
tags => [
{
tag => tag_id,
- multi => { (tag_id . sub_code) => [ val1, val2, ... ] },
+ multi => { code => [ val1, val2, ... ] },
uni => { code => value, code2 => value2, ... },
},
...
two more hashrefs, C<multi> and C<uni>.
The C<multi> hash holds the extracted data for tag/sub mappings which
-have the C<multiple> modifier on them. The keys in C<multi> are
-composed of the tag id and subfield code, catenated
-(e.g. C<901c>). The values are arrayrefs containing the content of all
+have the C<multiple> modifier on them. The keys in C<multi> subfield
+codes. The values are arrayrefs containing the content of all
instances of that subfield in that instance of that tag. If no tags
are defined as C<multi>, it will be C<undef>.
projects / migration-tools.git / blobdiff