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, biblevel => 1} },
60 $self->{conf}{file} = $args{file};
63 die "Can't open file: $!\n";
76 my ($self, @chunks) = @_;
77 return undef unless (defined $chunks[0]);
79 if ($chunks[0] =~ /^\d/) {
80 if (defined $chunks[1]) {
81 return 1 if ( defined $self->{tags}{$chunks[0]}{$chunks[1]} );
84 return 1 if ( defined $self->{tags}{$chunks[0]} );
88 if (defined $chunks[2]) {
89 return 1 if ( $self->{fields}{$chunks[0]}{tag} eq $chunks[1] and
90 $self->{fields}{$chunks[0]}{sub} eq $chunks[2] );
92 } elsif (defined $chunks[1]) {
93 return 1 if ( $self->{fields}{$chunks[0]}{tag} eq $chunks[1] );
96 return 1 if ( defined $self->{fields}{$chunks[0]} );
104 my ($self, $file) = @_;
106 open TAGFILE, '<', $self->{conf}{file};
112 my @tokens = split /\s+/;
114 if (defined $tokens[3]) {
115 $self->add( field => $tokens[0], tag => $tokens[1],
116 sub => $tokens[2], mod => $tokens[3] );
118 $self->add( field => $tokens[0], tag => $tokens[1], sub => $tokens[2] );
125 my ($self, %toks) = @_;
127 # check bits for validity
128 $self->validate(\%toks);
130 $toks{mod} = (defined $toks{mod}) ? $toks{mod} : 0;
132 $self->{fields}{$toks{field}} = { tag => $toks{tag}, sub => $toks{sub}, mod => $toks{mod}};
133 $self->{tags}{$toks{tag}}{$toks{sub}} = $toks{field};
137 my ($self, $toks) = @_;
139 $.= 1 unless defined $.;
141 die "Required field missing (line $.)\n"
142 unless (defined $toks->{field} and defined $toks->{tag} and defined $toks->{sub});
144 die "Fieldnames must start with letter (line $.)\n"
145 unless ($toks->{field} =~ /^\w/);
147 die "Invalid tag (line $.)\n"
148 if ($toks->{tag} =~ /\D/ or $toks->{tag} < 0 or $toks->{tag} > 999);
150 die "Invalid subfield code (line $.)\n"
151 if (length $toks->{sub} != 1 or $toks->{sub} =~ /[^a-z0-9]/);
153 # the next thing (if it exists), must be a comment or valid modifier
154 if (defined $toks->{mod}) {
155 die "Unknown chunk (line $.)\n"
156 unless (defined $self->{conf}{mods}{$toks->{mod}} or $toks->{mod} =~ /^#/);
159 die "Fieldnames must be unique (line $.)\n"
160 if (defined $self->{fields}{$toks->{field}});
162 die "Subfields cannot be multimapped (line $.)\n"
163 if (defined $self->{tags}{$toks->{tag}}{$toks->{sub}});
169 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
173 Please report any bugs or feature requests to the above email address.
177 You can find documentation for this module with the perldoc command.
179 perldoc Equinox::Migration::SubfieldMapper
182 =head1 COPYRIGHT & LICENSE
184 Copyright 2009 Equinox, all rights reserved.
186 This program is free software; you can redistribute it and/or modify it
187 under the same terms as Perl itself.
192 1; # End of Equinox::Migration::SimpleTagList