File Coverage

blib/lib/TextFileParser.pm
Criterion Covered Total %
statement 75 77 97.4
branch 28 34 82.3
condition 8 12 66.6
subroutine 21 22 95.4
pod 8 8 100.0
total 140 153 91.5


line stmt bran cond sub pod time code
1 2     2   67712 use warnings;
  2         29  
  2         57  
2 2     2   9 use strict;
  2         4  
  2         63  
3              
4             package TextFileParser 0.203;
5              
6             # ABSTRACT: an extensible Perl class to parse any text file by specifying grammar in derived classes.
7              
8 2     2   10 use Exporter 'import';
  2         2  
  2         172  
9             our (@EXPORT_OK) = ();
10             our (@EXPORT) = (@EXPORT_OK);
11              
12              
13             use Exception::Class (
14 2         23 'TextFileParser::Exception',
15             'TextFileParser::Exception::ParsingError' => {
16             isa => 'TextFileParser::Exception',
17             description => 'For all parsing errors',
18             alias => 'throw_text_parsing_error'
19             },
20             'TextFileParser::Exception::FileNotFound' => {
21             isa => 'TextFileParser::Exception',
22             description => 'File not found',
23             alias => 'throw_file_not_found'
24             },
25             'TextFileParser::Exception::FileCantOpen' => {
26             isa => 'TextFileParser::Exception',
27             description => 'Error opening file',
28             alias => 'throw_cant_open'
29             }
30 2     2   868 );
  2         20376  
31              
32 2     2   3135 use Try::Tiny;
  2         3966  
  2         1698  
33              
34              
35             sub new {
36 2     2 1 143 my $pkg = shift;
37 2         7 bless {}, $pkg;
38             }
39              
40              
41             sub read {
42 5     5 1 2338 my ( $self, $fname ) = @_;
43 5 100       16 return if not $self->__is_file_known_or_opened($fname);
44 4 100       22 $self->filename($fname) if not exists $self->{__filehandle};
45 3 100       9 delete $self->{__records} if exists $self->{__records};
46 3         12 $self->__read_file_handle;
47 3         76 $self->__close_file;
48             }
49              
50             sub __is_file_known_or_opened {
51 5     5   9 my ( $self, $fname ) = @_;
52 5 100 100     20 return 0 if not defined $fname and not exists $self->{__filehandle};
53 4 50 66     17 return 0 if defined $fname and not $fname;
54 4         10 return 1;
55             }
56              
57              
58             sub filename {
59 5     5 1 75 my ( $self, $fname ) = @_;
60 5 50       22 $self->__check_and_open_file($fname) if defined $fname;
61             return ( exists $self->{__filename} and defined $self->{__filename} )
62             ? $self->{__filename}
63 3 50 33     21 : undef;
64             }
65              
66             sub __check_and_open_file {
67 5     5   7 my ( $self, $fname ) = @_;
68 5 100 66     136 throw_file_not_found error =>
69             "No such file $fname or it has no read permissions"
70             if not -f $fname or not -r $fname;
71 3         14 $self->__open_file($fname);
72 3         19 $self->{__filename} = $fname;
73             }
74              
75             sub __open_file {
76 3     3   7 my ( $self, $fname ) = @_;
77 3 50       6 $self->__close_file if exists $self->{__filehandle};
78 3 50       92 open my $fh, "<$fname"
79             or throw_cant_open error => "Error while opening file $fname";
80 3         9 $self->{__filehandle} = $fh;
81 3         34 $self->{__size} = ( stat $fname )[7];
82             }
83              
84             sub __read_file_handle {
85 3     3   4 my $self = shift;
86 3         7 my $fh = $self->{__filehandle};
87 3         10 $self->__init_read_fh;
88 3         65 while (<$fh>) {
89 6         53 $self->lines_parsed( $self->lines_parsed + 1 );
90 6         14 $self->__try_to_parse($_);
91             }
92             }
93              
94             sub __init_read_fh {
95 3     3   5 my $self = shift;
96 3         10 $self->lines_parsed(0);
97 3         5 $self->{__bytes_read} = 0;
98             }
99              
100              
101             sub lines_parsed {
102 22     22 1 633 my $self = shift;
103 22 100       42 return $self->{__current_line} = shift if @_;
104 13 100       49 return ( exists $self->{__current_line} ) ? $self->{__current_line} : 0;
105             }
106              
107             sub __try_to_parse {
108 6     6   12 my ( $self, $line ) = @_;
109 6     6   321 try { $self->save_record($line); }
110             catch {
111 0     0   0 $self->__close_file;
112 0         0 $_->rethrow;
113 6         31 };
114             }
115              
116              
117             sub save_record {
118 7     7 1 67 my $self = shift;
119 7 50       15 return if not @_;
120 7 100       22 $self->{__records} = [] if not defined $self->{__records};
121 7         10 push @{ $self->{__records} }, shift;
  7         21  
122             }
123              
124             sub __close_file {
125 3     3   4 my $self = shift;
126 3         28 close $self->{__filehandle};
127 3         20 delete $self->{__filehandle};
128             }
129              
130              
131             sub get_records {
132 5     5 1 7 my $self = shift;
133 5 100       24 return () if not exists $self->{__records};
134 4         5 return @{ $self->{__records} };
  4         18  
135             }
136              
137              
138             sub last_record {
139 6     6 1 12 my $self = shift;
140 6 100       17 return undef if not exists $self->{__records};
141 5         8 my (@record) = @{ $self->{__records} };
  5         9  
142 5         19 return $record[$#record];
143             }
144              
145              
146             sub pop_record {
147 6     6 1 33 my $self = shift;
148 6 100       14 return undef if not exists $self->{__records};
149 5         7 pop @{ $self->{__records} };
  5         12  
150             }
151              
152             1;
153              
154             __END__