File Coverage

blib/lib/File/Format/CRD/Reader.pm
Criterion Covered Total %
statement 17 78 21.7
branch 0 16 0.0
condition 0 2 0.0
subroutine 6 16 37.5
pod 4 4 100.0
total 27 116 23.2


line stmt bran cond sub pod time code
1             package File::Format::CRD::Reader;
2             $File::Format::CRD::Reader::VERSION = '0.2.0';
3 1     1   802 use warnings;
  1         2  
  1         26  
4 1     1   6 use strict;
  1         2  
  1         14  
5              
6 1     1   13 use 5.008;
  1         3  
7              
8 1     1   4 use Carp;
  1         1  
  1         104  
9              
10 1     1   500 use Encode;
  1         8827  
  1         80  
11              
12 1     1   7 use Fcntl qw(SEEK_SET);
  1         2  
  1         559  
13              
14              
15              
16             sub new
17             {
18 0     0 1   my $class = shift;
19              
20 0           my $self = bless {}, $class;
21              
22 0           $self->_init(@_);
23              
24 0           return $self;
25             }
26              
27             sub _read_from
28             {
29 0     0     my ($self, $pos, $count) = @_;
30              
31 0 0         if (!seek($self->{_fh}, $pos, SEEK_SET))
32             {
33 0           Carp::confess("Cannot seek to $pos.");
34             }
35              
36 0           my $buffer = "";
37 0 0         if (read($self->{_fh}, $buffer, $count) != $count)
38             {
39 0           Carp::confess("Could not read $count bytes.");
40             }
41              
42 0           return $buffer;
43             }
44              
45             sub _read_short
46             {
47 0     0     my $self = shift;
48 0           my $pos = shift;
49              
50 0           my $buffer = $self->_read_from($pos, 2);
51              
52 0           return unpack("v", $buffer);
53             }
54              
55             sub _read_long
56             {
57 0     0     my $self = shift;
58 0           my $pos = shift;
59              
60 0           return unpack("V", $self->_read_from($pos, 4));
61             }
62              
63             sub _init
64             {
65 0     0     my ($self, $args) = @_;
66              
67 0           my $filename = $args->{'filename'};
68              
69 0 0         open my $in, "<", $filename
70             or Carp::confess "Could not open '$filename'";
71              
72 0           binmode ($in);
73              
74 0           $self->{_fh} = $in;
75              
76 0           my $magic = $self->_read_from(0, 3);
77              
78 0 0         if ($magic ne "MGC")
79             {
80 0           Carp::confess("Could not find magic number in file.");
81             }
82              
83 0           my $n_cards = $self->_read_short(3);
84              
85 0           $self->{_num_cards} = $n_cards;
86              
87 0           $self->{_card_idx} = 0;
88              
89 0           return;
90             }
91              
92              
93             sub get_num_cards
94             {
95 0     0 1   return shift->{_num_cards};
96             }
97              
98             sub DESTROY
99             {
100 0     0     my $self = shift;
101              
102 0           $self->finish();
103              
104 0           return;
105             }
106              
107              
108             sub finish
109             {
110 0     0 1   my $self = shift;
111              
112 0 0         if (exists($self->{_fh}))
113             {
114 0           close($self->{_fh});
115              
116 0           delete($self->{_fh});
117             }
118              
119 0           return;
120             }
121              
122              
123             sub get_next_card
124             {
125 0     0 1   my $self = shift;
126 0   0       my $args = shift || {};
127              
128 0           my $encoding = $args->{'encoding'};
129              
130 0           my $card_idx = $self->{_card_idx};
131              
132 0 0         if ($card_idx == $self->get_num_cards())
133             {
134 0           return;
135             }
136              
137 0           my $loc = 11 + $card_idx * 52;
138              
139 0           my $textloc = $self->_read_long($loc);
140              
141 0 0         if (! ($textloc >= 57))
142             {
143 0           Carp::confess("textloc is too small");
144             }
145              
146             my $transform = sub {
147 0     0     my $text = shift;
148              
149 0 0         if (defined($encoding))
150             {
151 0           return decode($encoding, $text);
152             }
153             else
154             {
155 0           return $text;
156             }
157 0           };
158              
159 0           my $title = $self->_read_from($loc+5, 52-5);
160              
161 0           my $ret = { 'title' => $transform->($title) };
162              
163 0           my $textlen = $self->_read_short($textloc+2);
164              
165 0           my $text = $self->_read_from($textloc+4, $textlen);
166              
167 0           $ret->{'body'} = $transform->($text);
168 0           ++($self->{_card_idx});
169              
170 0           return $ret;
171             }
172              
173              
174              
175             1; # End of File::Format::CRD::Reader
176              
177             __END__