File Coverage

blib/lib/WARC/Record/Stub.pm
Criterion Covered Total %
statement 31 31 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 43 43 100.0


line stmt bran cond sub pod time code
1             package WARC::Record::Stub; # -*- CPerl -*-
2              
3 27     27   61980 use strict;
  27         57  
  27         747  
4 27     27   121 use warnings;
  27         53  
  27         1088  
5              
6             our @ISA = qw(WARC::Record::FromVolume);
7              
8 27     27   526 use WARC; *WARC::Record::Stub::VERSION = \$WARC::VERSION;
  27         47  
  27         997  
9              
10 27     27   177 use Carp;
  27         59  
  27         5810  
11              
12             require WARC::Record::FromVolume;
13              
14             # This implementation uses a hash as the underlying structure.
15              
16             # Instances of this class carry only two keys: volume and offset.
17              
18             # Other method calls result in loading the full object.
19              
20             sub new {
21 215     215 1 7047 my $class = shift;
22 215         230 my $volume = shift;
23 215         247 my $offset = shift;
24              
25 215 100       655 croak "unbalanced key/value pairs" if scalar @_ % 2;
26              
27 214         484 my $ob = {volume => $volume, offset => $offset, @_};
28              
29 214         710 bless $ob, $class;
30             }
31              
32             sub _load_and_forward {
33 186     186   218 my $self = shift;
34 186         215 my $method = shift;
35              
36 186         373 my $new = _read WARC::Record::FromVolume ($self->volume, $self->offset);
37              
38 186         1909 $self->{$_} = $new->{$_} for keys %$new;
39 186         376 bless $self, ref $new;
40              
41 186         539 $self->$method(@_)
42             }
43              
44             BEGIN {
45 27     27   201 no strict 'refs';
  27         58  
  27         2153  
46 27     27   118 foreach my $sub (qw/ fields protocol next open_block replay open_payload /)
47 162     186   502 { *{$sub} = sub { (shift)->_load_and_forward($sub => @_)} }
  162         1334  
  186         7419  
48             }
49              
50             1;
51             __END__