File Coverage

blib/lib/Tie/FileSection.pm
Criterion Covered Total %
statement 91 97 93.8
branch 44 50 88.0
condition 36 42 85.7
subroutine 9 11 81.8
pod 1 1 100.0
total 181 201 90.0


line stmt bran cond sub pod time code
1 3     3   1867 use 5.10.0;
  3         16  
2 3     3   21 use strict;
  3         8  
  3         3263  
3             package Tie::FileSection;
4             $Tie::FileSection::VERSION = '0.171950';
5             # ABSTRACT: restrict files sequential access using array like boundaries
6             require Tie::Handle;
7             our @ISA = qw( Tie::StdHandle );
8              
9             sub new{
10 28 50   28 1 6874 my $pkg = $_[0] eq __PACKAGE__ ? shift : __PACKAGE__ ;
11 28         128 my %opts = @_;
12 28 50 66     135 $opts{filename} || $opts{file} or die "filename|file parameter is mandatory!";
13 28   100     104 my $first_line = $opts{first_line} // 0;
14 28   100     105 my $last_line = $opts{last_line} // 0;
15 28         60 my $use_real_line_nr = $opts{use_real_line_nr};
16 28         61 my $FH = $opts{file};
17 28 100 66     129 if(!$FH && defined $opts{filename}){
18 12 50       427 open $FH, '<', $opts{filename} or die "** could not open file $opts{filename} : $!\n";
19             }
20 28         157 tie *F, $pkg, $FH, $first_line, $last_line, $use_real_line_nr;
21 28         113 return \*F;
22             }
23              
24             sub TIEHANDLE{
25 28     28   87 my ($pkg, $FH, $first_line, $last_line, $use_real_line_nr) = @_;
26 28         205 my $self = bless {
27             handle => $FH,
28             first_line => $first_line,
29             last_line => $last_line,
30             init => 0, #lazy read
31             curr_line => 0,
32             use_real_line_nr => $use_real_line_nr,
33             line_buffer => [],
34             tell_buffer => [],
35             }, $pkg;
36 28         183 return $self;
37             }
38              
39             sub UNTIE{
40 0     0   0 my $fh = $_[0]->{handle};
41 0         0 undef $_[0];
42 0         0 close( $fh );
43             }
44              
45             sub EOF{
46 111     111   6742 my $self = shift;
47 111         244 my $f = $self->{first_line};
48 111         204 my $l = $self->{last_line};
49 111 50 100     535 if($f>=0 && $l>0 && $f > $l){ #static EOF
      66        
50 0         0 return 1;
51             }
52 111 50 100     462 if($f<0 && $l<0 && $l < $f ){ #static EOF
      66        
53 0         0 return 1;
54             }
55            
56 111 100 100     402 if($f<0 && $l>0){
57 16         86 return abs($f) + $self->{curr_line} >= $l;
58             }
59            
60 95 100 100     467 if($self->{init} && 0 <= $l && $l >= $self->{curr_line}){
      100        
61 6         32 return 1;
62             }
63            
64 89 100       433 if(eof( $self->{handle} )){
65             #take in account buffer here
66 33 100 100     105 if($l < 0 && scalar(@{$self->{line_buffer}})
  20         78  
67 12         61 return 1;
68             }
69             else{
70             #buffer not empty
71 21 100       38 return if @{$self->{line_buffer}};
  21         89  
72             }
73            
74 12         64 return 1;
75             }
76 56         177 return;
77             }
78              
79             sub TELL {
80 28     28   290 my $self = shift;
81 28         70 $. = $self->{curr_line};
82 28 100       93 return tell($self->{handle}) unless $self->{use_buffer};
83 16         45 return $self->{tell_buffer}[0];
84             }
85              
86             sub _readline{
87 63     63   114 my $self = shift;
88 63         121 my $fh = $self->{handle};
89 63         120 my $l = $self->{last_line};
90 63         107 my $tellbuff = $self->{tell_buffer};
91 63         116 my $linebuff = $self->{line_buffer};
92 63 100       174 unless($self->{init}++){
93 28         51 my $f = $self->{first_line};
94 28 100       92 if($f > 0){
    100          
95 10         19 my $i = $f;
96 10   66     81 while(--$i && defined scalar <$fh>){
97             }
98             }
99             elsif($f < 0){
100             #need to read until eof for abs($f) records
101 14         47 for(1..abs $f){
102 31         107 push @$tellbuff, tell($fh);
103 31         138 push @$linebuff, scalar <$fh>;
104             }
105 14         40 $self->{use_buffer}++;
106 14         51 while(!eof $fh){
107 41         78 shift @$tellbuff;
108 41         76 shift @$linebuff;
109 41         87 push @$tellbuff, tell($fh);
110 41         190 push @$linebuff, scalar <$fh>;
111             }
112             }
113 28 100 100     109 if($f > 0 && $l < 0){
114 4         16 for(1..abs $l){
115 8         22 push @$tellbuff, tell($fh);
116 8         27 push @$linebuff, scalar <$fh>;
117             }
118 4         11 $self->{use_buffer}++;
119             }
120 28 100       90 if(eof($fh)){
121             #add the final pos if requested aftere EOF.
122 14         37 push @$tellbuff, tell($fh);
123             }
124 28 100       72 if($self->{use_real_line_nr}){
125 3 100       105 $. -= @$linebuff if $self->{use_buffer};
126 3         13 $self->{curr_line} = $.;
127             }
128             else {
129 25         73 $. = undef;
130             }
131             }
132             #read one line and return it, take in accound first_line/last_line and buffer
133 63         151 my $eof = eof($fh);
134 63         127 my $pos = tell($fh);
135 63 100       215 my $line = $eof ? undef : <$fh>;
136 63 100       316 if($self->{use_buffer}){
137 35 100 50     169 unless($eof){
138 8         23 push @$linebuff, $line;
139 8         14 push @$tellbuff, $pos;
140             }
141             elsif($l < 0 && scalar(@$linebuff)
142             return;
143             }
144 35         83 $line = shift @$linebuff;
145 35 50       109 shift @$tellbuff unless @$tellbuff == 1; #always keep last pos
146             }
147 63         130 $self->{curr_line}++;
148 63         145 $. = $self->{curr_line};
149 63         265 return $line;
150             }
151              
152             sub READLINE {
153 99     99   18967 my $self = shift;
154 99 100       240 return if $self->EOF; #test basics boundaries
155 75 100       203 unless(wantarray){
156 63         177 return $self->_readline;
157             }
158             #ARRAY
159 12         26 my @rows;
160 12         39 while(defined($_=$self->READLINE)){
161 28         94 push @rows, $_;
162             }
163 12         62 @rows;
164             }
165              
166 12     12   184 sub CLOSE { close($_[0]->{handle}) }
167 0     0     sub FILENO { fileno($_[0]->{handle}) }
168             1;
169              
170             __END__