-package Equinox::Migration::MapDrivenXMLProc;
+package Equinox::Migration::MapDrivenMARCXMLProc;
use warnings;
use strict;
=head1 NAME
-Equinox::Migration::MapDrivenXMLProc
+Equinox::Migration::MapDrivenMARCXMLProc
=head1 VERSION
Foo
- use Equinox::Migration::MapDrivenXMLProc;
+ use Equinox::Migration::MapDrivenMARCXMLProc;
-=cut
+=head1 METHODS
+
+=head2 new
+Takes two required arguments: C<mapfile> (which will be passed along
+to L<Equinox::Migration::SubfieldMapper> as the basis for its map),
+and C<marcfile> (the MARC data to be processed).
-=head1 METHODS
+ my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( mapfile => FILE,
+ marcfile => FILE );
+There is an optional third, argument, C<sample>, which specifies a
+arrayref of datafields to "sample" by reporting on subfields which are
+found in the data but not in the map.
-=head2 new
+ my $m = Equinox::Migration::MapDrivenMARCXMLProc->new( mapfile => FILE,
+ marcfile => FILE,
+ sample => \@TAGS
+ );
+
+See L</UNMAPPED TAGS> for more info.
=cut
sub new {
my ($class, %args) = @_;
- my $self = bless { conf => { count => 0,
- total => 0,
- quiet => 0,
+ my $self = bless { mods => { multi => {},
+ once => {},
+ required => {},
+ },
+ data => { recs => undef, # X::T record objects
+ rptr => 0, # next record pointer
+ crec => undef, # parsed record storage
+ stag => undef, # list of tags to sample
+ umap => undef, # unmapped data samples
},
- map => Equinox::Migration::SubfieldMapper->new(file => $args{mapfile}),
- tags => {},
- twig => XML::Twig->new( twig_handlers => { record => \&record } ),
}, $class;
- if ($args{marcfile}) {
- if (-r $args{marcfile}) {
- $self->{conf}{marc} = $args{marcfile};
- $self->generate;
- } else {
- die "Can't open marc file: $!\n";
- }
+ # 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;
+
+ # initialize twig
+ die "Argument 'marcfile' must be specified\n" unless (defined $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;
+ } else {
+ die "Can't open marc file: $!\n";
}
- $self->{twig}->parsefile($self->{conf}{marc});
-
return $self;
}
-sub parse {
- my ($self) = @_;
-}
+=head2 parse_record
-sub emit_status {
- my ($self) = @_;
- my $c = $self->{conf};
- return if $c->{quiet};
- $c->{count}++;
- my $percent = int(($c->{count} / $c->{total}) * 100);
- print STDERR "\r$percent% done (", $c->{count}, ")";
-}
+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
+ }
+=cut
-=head2 XML::Twig CALLBACK ROUTINES
+sub parse_record {
+ my ($self) = @_;
-=head3 record
+ # 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} = { bib => undef, multi => undef };
-=cut
+ my @fields = $record->children;
+ for my $f (@fields)
+ { $self->process_field($f) }
-sub record {
- my($t, $r)= @_;
- $self->{holdings} = {};
+ # cleanup memory and increment pointer
+ $record->purge;
+ $self->{data}{rptr}++;
- my @dfields = $r->children('datafield');
- for my $d (@dfields) {
- process_datafields($d);
- }
- write_data_out();
- $r->purge;
+ return $self->format_record;
}
-=head3 process_datafields
+=head2 process_field
=cut
-sub process_datafields {
- my ($d) = @_;
+sub process_field {
+ my ($self, $field) = @_;
my $map = $self->{map};
- my $tag = $d->{'att'}->{'tag'};
-
- if ($tag == 903) {
- my $s = $d->first_child('subfield');
- $self->{holdings}{id} = $s->text;;
- } elsif ($map->has($tag)) {
- push @{$self->{holdings}{copies}}, { tag => $tag };
- my @subs = $d->children('subfield');
- for my $sub (@subs)
- { process_subs($tag, $sub) }
+ my $tag = $field->{'att'}->{'tag'};
+ my $parsed = $self->{data}{crec};
+
+ # datafields
+ if (defined $tag) {
+ if ($tag == 903) {
+ my $sub = $field->first_child('subfield');
+ $parsed->{egid} = $sub->text;;
+ } elsif ($map->has($tag)) {
+ push @{$parsed->{tags}}, { tag => $tag };
+ my @subs = $field->children('subfield');
+ for my $sub (@subs)
+ { $self->process_subs($tag, $sub) }
+ }
}
}
-=head3 process_subs
+=head2 process_subs
=cut
sub process_subs {
- my ($tag, $sub) = @_;
+ my ($self, $tag, $sub) = @_;
my $map = $self->{map};
my $code = $sub->{'att'}->{'code'};
+ # handle unmapped tag/subs
unless ($map->has($tag, $code)) {
- # this is a subfield code we don't have mapped. report on it if this is a sample tag
- push @{$c->{sample}{$tag}}, $code if defined $c->{sample}{tag};
+ my $u = $self->{data}{umap};
+ my $s = $self->{data}{stag};
+ return unless (defined $s->{$tag});
+
+ $u->{$tag}{$code}{value} = $sub->text unless defined $u->{$tag}{$code};
+ $u->{$tag}{$code}{count}++;
return;
}
- my $copy = $self->{holdings}{copies}[-1];
+ my $data = $self->{data}{crec}{tags}[-1];
my $field = $map->field($tag, $code);
- if ($map->mod($field) eq 'multi') {
- my $name = $tag . $code;
- push @{$copy->{multi}{$name}}, $sub->text;
- } else {
- $copy->{uni}{$code} = $sub->text;
+
+ # handle modifiers
+ if (defined $map->mods($field)) {
+ if ($map->mods($field) eq 'multi') {
+ my $name = $tag . $code;
+ push @{$data->{multi}{$name}}, $sub->text;
+ }
}
+
+ $data->{uni}{$code} = $sub->text;
}
+=head1 PARSED RECORDS
+
+ {
+ egid => evergreen_record_id,
+ bib => {
+ (tag_id . sub_code)1 => value1,
+ (tag_id . sub_code)2 => value2,
+ ...
+ },
+ tags => [
+ {
+ tag => tag_id,
+ multi => { (tag_id . sub_code) => [ val1, val2, ... ] },
+ uni => { code => value, code2 => value2, ... },
+ },
+ ...
+ ]
+ }
+
+That is, there is an C<egid> key which points to the Evergreen ID of
+that record, a C<bib> key which points to a hashref, and a C<tags>
+key which points to an arrayref.
+
+=head3 C<bib>
+
+This hashref holds extracted data which should occur once per record
+(the default assumption is that a tag/subfield pair can occur multiple
+times per record). The keys are composed of tag id and subfield code,
+catenated (e.g. 901c). The values are the contents of that subfield of
+that tag.
+
+If there are no tags defined as bib-level, C<bib> will be C<undef>.
+
+=head3 C<tags>
+
+This arrayref holds anonymous hashrefs, one for each instance of each
+tag which occurs in the map. Each tag hashref holds its own id
+(e.g. C<998>), and two more hashrefs, C<multi> and C<uni>.
+
+The C<multi> hashref 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
+instances of that subfield in that instance of that tag.
+
+The C<uni> hashref holds data for tag/sub mappings which occur only
+once per instance of a tag (but may occur multiple times in a record
+due to there being multiple instances of that tag in a record). Keys
+are subfield codes and values are subfield content.
+
+If no tags are defined as C<multi>, it will be C<undef>.
+
+=head1 UNMAPPED TAGS
+
+ { tag_id => {
+ sub_code => { value => VALUE, count => COUNT },
+ sub_code2 => { value => VALUE, count => COUNT },
+ ...
+ },
+ ...
+ }
+
=head1 AUTHOR
Shawn Boyette, C<< <sboyette at esilibrary.com> >>
You can find documentation for this module with the perldoc command.
- perldoc Equinox::Migration::MapDrivenXMLProc
+ perldoc Equinox::Migration::MapDrivenMARCXMLProc
=head1 COPYRIGHT & LICENSE
=cut
-1; # End of Equinox::Migration::MapDrivenXMLProc
+1; # End of Equinox::Migration::MapDrivenMARCXMLProc