=head1 VERSION
-Version 1.002
+Version 1.003
=cut
-our $VERSION = '1.002';
+our $VERSION = '1.003';
my $dstore;
my $sfmap;
my @mods = qw( multi bib required );
+my $multis = {};
+my $reccount;
+my $verbose = 0;
+
=head1 SYNOPSIS
sub new {
my ($class, %args) = @_;
- my $self = bless {
+ $verbose = 1 if $args{verbose};
+
+ my $self = bless { multis => \$multis,
}, $class;
# initialize map and taglist
mods => \@mods );
# initialize datastore
+ die "Datastore file 'EMMXSSTORAGE.dbmd' already exists. Exiting.\n"
+ if (-e "EMMXSSTORAGE.dbmd");
$dstore = DBM::Deep->new( file => "EMMXSSTORAGE.dbmd",
- data_sector_size => 256 );
- $dstore->{rptr} = 0; # next record ptr
+ max_buckets => 64,
+ #data_sector_size => 256,
+ autoflush => 0,
+ );
+ $reccount = 0; # next record ptr
$dstore->{tags} = $sfmap->tags; # list of all tags
$self->{data} = $dstore;
# cleanup memory and increment pointer
$record->purge;
- $dstore->{rptr}++;
+ $reccount++;
# check for required fields
check_required();
push @{ $dstore->{recs} }, $crec;
+
+ print STDERR "$reccount\n"
+ if ($verbose and !($reccount % 1000));
}
sub process_field {
{ process_subs($tag, $sub, $crec) }
# check map to ensure all declared tags and subs have a value
- my $mods = $sfmap->mods($field);
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};
# handle unmapped tag/subs
return unless ($sfmap->has($tag, $code));
- # fetch our datafield struct and fieldname
+ # fetch our datafield struct and fiel
my $dataf = $crec->{tags}[-1];
my $field = $sfmap->field($tag, $code);
- $crec->{names}{$tag}{$code} = $field;
# test filters
for my $filter ( @{$sfmap->filters($field)} ) {
return if ($sub->text =~ /$filter/i);
}
+
# handle multi modifier
if (my $mods = $sfmap->mods($field)) {
if ($mods->{multi}) {
push @{$dataf->{multi}{$code}}, $sub->text;
+ $multis->{$tag}{$code} = 1;
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 ",
- ($dstore->{rptr} + 1),"\n" if (defined $dataf->{uni}{$code});
+ ($reccount + 1),"\n" if (defined $dataf->{uni}{$code});
# everything seems okay
$dataf->{uni}{$code} = $sub->text;
$found = 1 if ($tag->{uni}{$code});
}
- die "Required mapping $tag_id$code not found in rec ",$dstore->{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 passed a record number, tag, and code
+Returns mapped fieldname when passed a tag, and code
+
+ my $name = $m->name(999,'a');
- my $name = $m->name(3,999,'a');
+=cut
+
+sub name { my ($self, $t, $c) = @_; return $sfmap->field($t, $c) }
+
+=head2 get_multis
+
+Returns hashref of C<{tag}{code}> for all mapped multi fields
=cut
-sub name { my ($self, $r, $t, $c) = @_; return $dstore->{recs}[$r]{names}{$t}{$c} };
+sub get_multis {
+ my ($self) = @_;
+ return $multis;
+}
=head1 MODIFIERS