1 package Equinox::Migration::SubfieldMapper;
8 Equinox::Migration::SubfieldMapper - Generate named-field to MARC tag map from file
16 our $VERSION = '1.000';
21 Using a file as input, E::M::SM generates a mapping of MARC subfields
22 to arbitrary field names, and provides several access mechanisms to
25 use Equinox::Migration::SubfieldMapper;
27 my $stl = Equinox::Migration::SubfieldMapper->new( file => ".txt" );
28 my $tags = $stl->as_hashref;
32 my $stl = Equinox::Migration::SubfieldMapper->new( file => ".txt" );
33 if ( $stl->has($foo) ) {
34 # if $foo is an element of $stl's parsed list
44 Takes one optional argument, C<file>. If this is speficied, the tag
45 list will be populated as per that file on instantiation.
47 Returns a E::M::STL object.
52 my ($class, %args) = @_;
54 my $self = bless { conf => { mods => { multi => 1, bib => 1, req => 1, bibreq => 1 } },
60 $self->{conf}{file} = $args{file};
63 die "Can't open file: $!\n";
72 Ask it whether you mapping has various things, and it'll let you know.
74 $sm->has('fieldname') # is this fieldname mapped?
75 $sm->has(901) # are there any mappings for this tag?
76 $sm->has(650,'c') # is this tag/subfield combo mapped?
77 $sm->has('name', 245, 'a') # is this name mapped to 245$a?
79 Returns 1 if true, 0 if false.
81 FIXME: use named params instead of positional
86 my ($self, @chunks) = @_;
87 return undef unless (defined $chunks[0]);
89 if ($chunks[0] =~ /^\d/) {
90 if (defined $chunks[1]) {
91 return 1 if ( defined $self->{tags}{$chunks[0]}{$chunks[1]} );
94 return 1 if ( defined $self->{tags}{$chunks[0]} );
98 if (defined $chunks[2]) {
99 return 1 if ( $self->{fields}{$chunks[0]}{tag} eq $chunks[1] and
100 $self->{fields}{$chunks[0]}{sub} eq $chunks[2] );
102 } elsif (defined $chunks[1]) {
103 return 1 if ( $self->{fields}{$chunks[0]}{tag} eq $chunks[1] );
106 return 1 if ( defined $self->{fields}{$chunks[0]} );
114 Given a tag and subfield code,
116 my $fname = $sm->field(945, 'p')
118 return the name mapped to them. Returns C<undef> if no mapping exists.
123 my ($self, $tag, $sub) = @_;
124 return undef unless (defined $tag and defined $sub);
125 return undef unless $self->has($tag, $sub);
126 return $self->{tags}{$tag}{$sub};
131 Returns the modifier set on a mapping.
133 if ($sm->mod('field) eq "bib")
135 If there is no modifier, C<0> will be returned. At the moment, the
138 * multi - This field is expected to be seen multiple times per
141 * bib - This is a bib-level field, and is expected to be seen only
142 once per record (normal is once per datafield)
144 * req - This field is required to occur before output
146 * bibreq - Both 'bib' and 'req'
151 my ($self, $field) = @_;
152 return undef unless $self->has($field);
153 return $self->{fields}{$field}{mod};
158 Generate initial mapping from file.
163 my ($self, $file) = @_;
165 open TAGFILE, '<', $self->{conf}{file};
171 my @tokens = split /\s+/;
173 if (defined $tokens[3]) {
174 $self->add( field => $tokens[0], tag => $tokens[1],
175 sub => $tokens[2], mod => $tokens[3] );
177 $self->add( field => $tokens[0], tag => $tokens[1], sub => $tokens[2] );
185 Add new item to mapping. Not usually called directly from user code.
187 $sm->add( field => 'value', tag => num, sub => 'c' );
188 $sm->add( field => 'value', tag => num,
189 sub => 'c', mod => 'modifier' );
194 my ($self, %toks) = @_;
196 # check bits for validity
197 $self->validate(\%toks);
199 $toks{mod} = (defined $toks{mod} and $toks{mod} !~ /^#/) ? $toks{mod} : 0;
201 $self->{fields}{$toks{field}} = { tag => $toks{tag}, sub => $toks{sub}, mod => $toks{mod}};
202 $self->{tags}{$toks{tag}}{$toks{sub}} = $toks{field};
207 Passed a reference to the hash given to C<add>, validate scans its
208 contents for common errors and dies if there is an issue.
210 * field, tag, and sub are required
211 * fieldnames must start with a letter
212 * fieldnames must be unique
213 * tag must be between 0 and 999
214 * subfield code must be a single alphanumeric character
215 * tag+subfield can only be mapped once
220 my ($self, $toks) = @_;
222 $.= 1 unless defined $.;
224 die "Required field missing (line $.)\n"
225 unless (defined $toks->{field} and defined $toks->{tag} and defined $toks->{sub});
227 die "Fieldnames must start with letter (line $.)\n"
228 unless ($toks->{field} =~ /^[a-zA-z]/);
230 die "Invalid tag (line $.)\n"
231 if ($toks->{tag} =~ /\D/ or $toks->{tag} < 0 or $toks->{tag} > 999);
233 die "Invalid subfield code (line $.)\n"
234 if (length $toks->{sub} != 1 or $toks->{sub} =~ /[^a-zA-Z0-9]/);
236 # the next thing (if it exists), must be a comment or valid modifier
237 if (defined $toks->{mod}) {
238 die "Unknown chunk (line $.)\n"
239 unless (defined $self->{conf}{mods}{$toks->{mod}} or $toks->{mod} =~ /^#/);
242 die "Fieldnames must be unique (line $.)\n"
243 if (defined $self->{fields}{$toks->{field}});
245 die "Subfields cannot be multimapped (line $.)\n"
246 if (defined $self->{tags}{$toks->{tag}}{$toks->{sub}});
252 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
256 Please report any bugs or feature requests to the above email address.
260 You can find documentation for this module with the perldoc command.
262 perldoc Equinox::Migration::SubfieldMapper
265 =head1 COPYRIGHT & LICENSE
267 Copyright 2009 Equinox, all rights reserved.
269 This program is free software; you can redistribute it and/or modify it
270 under the same terms as Perl itself.
275 1; # End of Equinox::Migration::SimpleTagList