File Coverage

blib/lib/Plucene/Store/OutputStream.pm
Criterion Covered Total %
statement 51 62 82.2
branch 2 4 50.0
condition 1 3 33.3
subroutine 16 22 72.7
pod 15 15 100.0
total 85 106 80.1


line stmt bran cond sub pod time code
1             package Plucene::Store::OutputStream;
2              
3             =head1 NAME
4              
5             Plucene::Store::OutputStream - a random-access output stream
6              
7             =head1 SYNOPSIS
8              
9             # isa Plucene::Store::InputStream
10              
11             =head1 DESCRIPTION
12              
13             This is an abstract class for output to a file in a Directory.
14             A random-access output stream.
15             Used for all Plucene index output operations.
16              
17             =head1 METHODS
18              
19             =cut
20              
21 20     20   859 use strict;
  20         41  
  20         615  
22 20     20   99 use warnings;
  20         42  
  20         773  
23 20     20   103 no warnings 'uninitialized';
  20         43  
  20         751  
24              
25 20     20   2126 use Encode qw(encode);
  20         25804  
  20         5113  
26              
27             =head2 new
28              
29             Create a new Plucene::Store::OutputStream
30              
31             =cut
32              
33             sub new {
34 2750     2750 1 1580018 my ($self, $filename) = @_;
35 2750   33     16715 $self = ref $self || $self;
36 2750 50       1165023 open my $fh, '>', $filename
37             or die "$self cannot open $filename for writing: $!";
38 2750         7438 binmode $fh;
39 2750         42944 bless [ $fh, $filename ], $self;
40             }
41              
42 2750     2750   258507 sub DESTROY { CORE::close $_[0]->[0] }
43              
44             =head2 clone
45              
46             Clone this
47              
48             =cut
49              
50             sub clone {
51 0     0 1 0 my $orig = shift;
52 0         0 my $clone = $orig->new($orig->[1]);
53 0         0 CORE::seek($clone->[0], CORE::tell($orig->[0]), 0);
54 0         0 return $clone;
55             }
56              
57             =head2 fh / read / seek / tell / getc / print / eof / close
58              
59             File operations
60              
61             =cut
62              
63 20     20   159 use Carp 'croak';
  20         47  
  20         7410  
64 0     0 1 0 sub fh { croak "OutputStream fh called" }
65 0     0 1 0 sub read { croak "OutputStream read called" }
66 594     594 1 20615 sub seek { CORE::seek $_[0]->[0], $_[1], $_[2] }
67 1916     1916 1 8367 sub tell { CORE::tell $_[0]->[0] }
68 0     0 1 0 sub getc { croak "OutputStream getc called" }
69 2868     2868 1 11470 sub print { local $\; my $fh = shift->[0]; CORE::print $fh @_ }
  2868         6335  
  2868         14692  
70 0     0 1 0 sub eof { CORE::eof $_[0]->[0] }
71 2     2 1 111 sub close { CORE::close $_[0]->[0] }
72              
73             =head2 write_byte
74              
75             This will write a single byte.
76              
77             =cut
78              
79             sub write_byte {
80 0     0 1 0 local $\;
81 0         0 CORE::print { $_[0]->[0] } $_[1];
  0         0  
82             }
83              
84             =head2 write_int
85              
86             This will write an int as four bytes.
87              
88             =cut
89              
90             sub write_int {
91 3448     3448 1 11408 local $\;
92 3448         4900 CORE::print { $_[0]->[0] } pack("N", $_[1]);
  3448         114725  
93             }
94              
95             =head2 write_vint
96              
97             This will write an int in a variable length format.
98              
99             =cut
100              
101             sub write_vint {
102 283155     283155 1 1593105 local $\;
103 20     20   133 use bytes;
  20         37  
  20         172  
104 283155         370140 my $i = $_[1];
105 283155         312283 my $txt;
106 283155         673139 while ($i & ~0x7f) {
107 1365         2242 $txt .= chr($i | 0x80);
108 1365         3215 $i >>= 7;
109             }
110 283155         390481 $txt .= chr($i);
111 283155         308448 CORE::print { $_[0]->[0] } $txt;
  283155         987356  
112             }
113              
114             =head2 write_long
115              
116             This will write a long as eight bytes.
117              
118             =cut
119              
120             sub write_long {
121 646     646 1 2219 local $\;
122 646         926 CORE::print { $_[0]->[0] }
  646         6060  
123             pack("NN", 0xffffffff & ($_[1] >> 32), 0xffffffff & $_[1]);
124             }
125              
126             =head2 write_vlong
127              
128             This will write a long in variable length format.
129              
130             =cut
131              
132             *write_vlong = *write_vint;
133              
134             =head2 write_string
135              
136             This will write a string.
137              
138             =cut
139              
140             sub write_string {
141 47523     47523 1 92852 local $\;
142 47523         88983 my $s = $_[1];
143 47523 50       162685 $s = encode("utf8", $s) if $s =~ /[^\x00-\x7f]/;
144 47523         117595 $_[0]->write_vint(length $s);
145 47523         63354 CORE::print { $_[0]->[0] } $s;
  47523         186508  
146             }
147              
148             1;