File Coverage

blib/lib/Tie/MAB2/Id.pm
Criterion Covered Total %
statement 8 10 80.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 12 14 85.7


line stmt bran cond sub pod time code
1             package Tie::MAB2::Id;
2              
3 1     1   1426 use strict;
  1         2  
  1         31  
4              
5             BEGIN {
6 1     1   796 use Tie::Hash;
  1         913  
  1         35  
7 1     1   28 our @ISA = qw(Tie::StdHash);
8             }
9              
10 1     1   340 use BerkeleyDB qw( DB_RDONLY DB_CREATE DB_FAST_STAT );
  0            
  0            
11              
12             warn sprintf "WARNING: Recommended Berkeley DB version is 4.0 or higher. Yours is %s.
13             Be prepared for trouble!", $BerkeleyDB::db_version if $BerkeleyDB::db_version<4;
14              
15             use Fcntl qw( SEEK_SET );
16             use MAB2::Record::Base;
17              
18             our $VERSION = sprintf "%d.%03d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
19              
20              
21             sub TIEHASH {
22             my($class,%args) = @_;
23             my $self = {};
24             $self->{ARGS} = \%args;
25             die "Could not tie: required argument file missing" unless exists $args{file};
26             open my $fh, "<", $args{file} or Carp::confess("Could not open $args{file}: $!");
27             $self->{FH} = $fh;
28             # warn sprintf "Filesize: %d\n", -s $fh;
29             my %offset;
30             # ("BerkeleyDB::Recno", -Filename => "$args{file}.bdbrecno", -Flags => DB_RDONLY, -Mode => 0600);
31              
32             my $db = tie(%offset, "BerkeleyDB::Hash", -Filename => "$args{file}.bdbhash", -Flags => DB_RDONLY, -Mode => 0644);
33              
34             #############################################^^^^^^^ did simply not work with RDONLY
35             unless ($db) {
36             $db = tie(%offset, "BerkeleyDB::Hash", -Filename => "$args{file}.bdbhash", -Flags => DB_CREATE, -Mode => 0644) or die "Could not tie $args{file}.bdbhash: $!";
37             local($/) = "\n";
38             my $Loffset = 0;
39             local($|) = 1;
40             while (<$fh>) {
41             chomp;
42             my $obj = MAB2::Record::Base->new($_);
43             $offset{$obj->id} = $Loffset;
44             my $offset = tell $fh;
45             printf "." unless int $offset/1000000 == int $Loffset/1000000;
46             $Loffset = $offset;
47             }
48             }
49             my $stat = $db->db_stat(DB_FAST_STAT);
50             # use Data::Dumper;
51             # print Data::Dumper::Dumper($stat);
52             $self->{OFFSET} = \%offset;
53             bless $self, ref $class || $class;
54             }
55              
56             sub UNTIE {
57             my $self = shift;
58             close $self->{FH};
59             untie %{$self->{OFFSET}};
60             }
61              
62             sub FETCH {
63             my($self, $key) = @_;
64             my $fh = $self->{FH};
65             my $offset = $self->{OFFSET}{$key};
66             return undef unless defined $offset;
67             seek $fh, $offset, SEEK_SET;
68             local($/) = "\n";
69             my $rec = <$fh>;
70             chomp $rec;
71             my $obj = MAB2::Record::Base->new($rec,$key);
72             $obj;
73             }
74              
75             for my $method (qw(STORE DELETE CLEAR)) {
76             no strict "refs";
77             *$method = sub {
78             warn "$method not supported on ".ref shift;
79             return;
80             };
81             }
82              
83             sub EXISTS {
84             my($self, $key) = @_;
85             exists $self->{OFFSET}{$key};
86             }
87              
88             sub NEXTKEY {
89             my $self = shift;
90             return each %{ $self->{OFFSET} };
91             }
92              
93             sub FIRSTKEY {
94             my $self = shift;
95             my $a = keys %{$self->{OFFSET}};
96             return each %{ $self->{OFFSET} };
97             }
98              
99             1;
100              
101             __END__