Equinox-Migration/lib/Equinox/Migration/SubfieldMapper.pm

   1 package Equinox::Migration::SubfieldMapper;
   2
   3 use warnings;
   4 use strict;
   5
   6 =head1 NAME
   7
   8 Equinox::Migration::SubfieldMapper - Generate named-field to MARC tag map from file
   9
  10 =head1 VERSION
  11
  12 Version 1.000
  13
  14 =cut
  15
  16 our $VERSION = '1.000';
  17
  18
  19 =head1 SYNOPSIS
  20
  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
  23 that set.
  24
  25     use Equinox::Migration::SubfieldMapper;
  26
  27     my $stl = Equinox::Migration::SubfieldMapper->new( file => ".txt" );
  28     my $tags = $stl->as_hashref;
  29
  30 or
  31
  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
  35         # do stuff ...
  36     }
  37
  38
  39 =head1 ROUTINES
  40
  41
  42 =head2 new
  43
  44 Takes one optional argument, C<file>. If this is speficied, the tag
  45 list will be populated as per that file on instantiation.
  46
  47 Returns a E::M::STL object.
  48
  49 =cut
  50
  51 sub new {
  52     my ($class, %args) = @_;
  53
  54     my $self = bless { conf   => { mods => { multi => 1, biblevel => 1} },
  55                        fields => {},
  56                        tags   => {} }, $class;
  57
  58     if ($args{file}) {
  59         if (-r $args{file}) {
  60             $self->{conf}{file} = $args{file};
  61             $self->generate;
  62         } else {
  63             die "Can't open  file: $!\n";
  64         }
  65     }
  66
  67     return $self;
  68 }
  69
  70
  71 =head2 generate
  72
  73 =cut
  74
  75 sub has {
  76     my ($self, @chunks) = @_;
  77     return undef unless (defined $chunks[0]);
  78
  79     if ($chunks[0] =~ /^\d/) {
  80         if (defined $chunks[1]) {
  81             return 1 if ( defined $self->{tags}{$chunks[0]}{$chunks[1]} );
  82             return 0;
  83         } else {
  84             return 1 if ( defined $self->{tags}{$chunks[0]} );
  85             return 0;
  86         }
  87     } else {
  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] );
  91             return undef;
  92         } elsif (defined $chunks[1]) {
  93             return 1 if ( $self->{fields}{$chunks[0]}{tag} eq $chunks[1] );
  94             return undef;
  95         } else {
  96             return 1 if ( defined $self->{fields}{$chunks[0]} );
  97             return undef;
  98         }
  99     }
 100 }
 101
 102
 103 sub generate {
 104     my ($self, $file) = @_;
 105
 106     open TAGFILE, '<', $self->{conf}{file};
 107     while (<TAGFILE>) {
 108         next if m/^#/;
 109         next if m/^\s*\n$/;
 110
 111         chomp;
 112         my @tokens = split /\s+/;
 113
 114         if (defined $tokens[3]) {
 115             $self->add( field => $tokens[0], tag => $tokens[1],
 116                         sub   => $tokens[2], mod => $tokens[3] );
 117         } else {
 118             $self->add( field => $tokens[0], tag => $tokens[1], sub => $tokens[2] );
 119         }
 120     }
 121
 122 }
 123
 124 sub add {
 125     my ($self, %toks) = @_;
 126
 127     # check bits for validity
 128     $self->validate(\%toks);
 129
 130     $toks{mod} = (defined $toks{mod}) ? $toks{mod} : 0;
 131
 132     $self->{fields}{$toks{field}} = { tag => $toks{tag}, sub => $toks{sub}, mod => $toks{mod}};
 133     $self->{tags}{$toks{tag}}{$toks{sub}} = $toks{field};
 134 }
 135
 136 sub validate {
 137     my ($self, $toks) = @_;
 138
 139     $.= 1 unless defined $.;
 140
 141     die "Required field missing (line $.)\n"
 142       unless (defined $toks->{field} and defined $toks->{tag} and defined $toks->{sub});
 143
 144     die "Fieldnames must start with letter (line $.)\n"
 145      unless ($toks->{field} =~ /^\w/);
 146
 147     die "Invalid tag (line $.)\n"
 148       if ($toks->{tag} =~ /\D/ or $toks->{tag} < 0 or $toks->{tag} > 999);
 149
 150     die "Invalid subfield code (line $.)\n"
 151       if (length $toks->{sub} != 1 or $toks->{sub} =~ /[^a-z0-9]/);
 152
 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} =~ /^#/);
 157     }
 158
 159     die "Fieldnames must be unique (line $.)\n"
 160       if (defined $self->{fields}{$toks->{field}});
 161
 162     die "Subfields cannot be multimapped (line $.)\n"
 163       if (defined $self->{tags}{$toks->{tag}}{$toks->{sub}});
 164 }
 165
 166
 167 =head1 AUTHOR
 168
 169 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
 170
 171 =head1 BUGS
 172
 173 Please report any bugs or feature requests to the above email address.
 174
 175 =head1 SUPPORT
 176
 177 You can find documentation for this module with the perldoc command.
 178
 179     perldoc Equinox::Migration::SubfieldMapper
 180
 181
 182 =head1 COPYRIGHT & LICENSE
 183
 184 Copyright 2009 Equinox, all rights reserved.
 185
 186 This program is free software; you can redistribute it and/or modify it
 187 under the same terms as Perl itself.
 188
 189
 190 =cut
 191
 192 1; # End of Equinox::Migration::SimpleTagList