File Coverage

blib/lib/App/dategrep/Iterator/File.pm
Criterion Covered Total %
statement 70 84 83.3
branch 25 40 62.5
condition 9 14 64.2
subroutine 10 10 100.0
pod 0 3 0.0
total 114 151 75.5


line stmt bran cond sub pod time code
1             package App::dategrep::Iterator::File;
2 8     8   28 use strict;
  8         9  
  8         174  
3 8     8   28 use warnings;
  8         5  
  8         146  
4 8     8   23 use Fcntl ":seek";
  8         9  
  8         858  
5 8     8   29 use Moo;
  8         8  
  8         34  
6 8     8   4449 use FileHandle;
  8         4944  
  8         32  
7             extends 'App::dategrep::Iterator';
8              
9             has 'filename' => ( is => 'ro', required => 1 );
10             has 'blocksize' => ( is => 'lazy' );
11             has 'tell_beg' => ( is => 'rw' );
12             has 'tell_end' => ( is => 'rw' );
13              
14             sub _build_blocksize {
15 23     23   2590 my $self = shift;
16 23   50     490 return ( stat( $self->filename ) )[11] || 8192;
17             }
18              
19             sub _build_fh {
20 24     24   1977 my $self = shift;
21 24         62 my ( $fh, $tell_beg, $tell_end ) = $self->byte_offsets();
22 21         92 $self->tell_beg($tell_beg);
23 21         42 $self->tell_end($tell_end);
24 21         62 $fh->seek( $tell_beg, SEEK_SET );
25 21         443 return $fh;
26             }
27              
28             sub get_entry_unbuffered {
29 83     83 0 70 my $self = shift;
30 83         165 my $line = $self->getline();
31             ## TODO can $tell_end be undefined?
32             return
33 80 100 100     2636 if defined( $self->tell_end ) && ( $self->fh->tell > $self->tell_end );
34 75 100       248 if ( $self->multiline ) {
35 3   66     52 while ( !$self->fh->eof && !$self->next_line_has_date ) {
36 2         8 $line .= $self->getline();
37             }
38             }
39 75         294 return $line;
40             }
41              
42             sub byte_offsets {
43 26     26 0 28 my $self = shift;
44 26         61 my $filename = $self->filename;
45 26 100       1018 open( my $fh, '<', $filename ) or die "Can't open $filename: $!\n";
46 25         537 my $test_line = $fh->getline;
47 25 100       750 if ( defined($test_line) ) {
48 24         103 my ( $epoch, $error ) = $self->to_epoch( $test_line );
49 24 100       4525 if ($error) {
50 1         44 die "No date found in first line: $error\n";
51             }
52 23         130 $fh->seek(0, SEEK_SET );
53              
54 23         256 my $tell_beg = $self->search( $fh, $self->start, format => $self->format, );
55              
56 23 100       52 if ( defined $tell_beg ) {
57 22         133 my $tell_end = $self->search( $fh, $self->end, min_byte => $tell_beg, format => $self->format );
58              
59 21         63 return $fh, $tell_beg, $tell_end;
60             }
61             }
62             # return for empty file
63 2         5 return $fh, 0, -1;
64             }
65              
66             sub search {
67 45     45 0 61 my $self = shift;
68 45         111 my ( $fh, $key, %options ) = @_;
69 45 50       152 my @stat = $fh->stat or return;
70 45         556 my $size = $stat[7];
71 45         1304 my $blksize = $self->blocksize;
72              
73 45         251 my $min_byte = $options{min_byte};
74 45         92 my $multiline = $self->multiline;
75              
76             # find the right block
77 45         113 my ( $min, $max, $mid ) = ( 0, int( $size / $blksize ) );
78              
79 45 100       91 if ( defined $min_byte ) {
80 22         35 $min = int( $min_byte / $blksize );
81             }
82              
83 45         92 BLOCK: while ( $max - $min > 1 ) {
84 0         0 $mid = int( ( $max + $min ) / 2 );
85 0 0       0 $fh->seek($mid * $blksize, 0 ) or return;
86 0 0       0 $fh->getline if $mid; # probably a partial line
87 0         0 LINE: while ( my $line = $fh->getline() ) {
88 0         0 my ($epoch) = $self->to_epoch( $line );
89 0 0       0 if ( !$epoch ) {
90 0 0 0     0 next LINE if $multiline || $self->skip_unparsable;
91              
92 0         0 chomp($line);
93 0         0 die "Unparsable line: $line\n";
94             }
95 0 0       0 if ($multiline) {
96 0         0 my $byte = $fh->tell;
97 0         0 $mid = int( $byte / $blksize );
98             }
99 0 0       0 $epoch < $key
100             ? $min = $mid
101             : $max = $mid;
102 0         0 next BLOCK;
103             }
104             }
105              
106             # find the right line
107 45         47 $min *= $blksize;
108 45 50       114 $fh->seek( $min, 0 ) or return;
109 45 50       336 $fh->getline if $min; # probably a partial line
110 45         36 for ( ; ; ) {
111 138         348 $min = $fh->tell;
112 138 100       3271 defined( my $line = $fh->getline ) or last;
113 120         2881 my ($epoch) = $self->to_epoch( $line );
114 120 100       24910 if ( !$epoch ) {
115 8 100 100     45 next if $multiline || $self->skip_unparsable;
116 1         3 chomp($line);
117 1         21 die "Unparsable line: $line\n";
118             }
119 112 100       219 if ( $epoch >= $key ) {
120 26         79 $fh->seek($min, 0 );
121 26         763 return $min;
122             }
123             }
124 18         476 return;
125             }
126              
127             1;