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   51832 use warnings;
  2         15  
  2         45  
2 2     2   7 use strict;
  2         2  
  2         51  
3              
4             package TextFileParser 0.202;
5              
6             # ABSTRACT: an extensible Perl class to parse any text file by specifying grammar in derived classes.
7              
8 2     2   8 use Exporter 'import';
  2         2  
  2         137  
9             our (@EXPORT_OK) = ();
10             our (@EXPORT) = (@EXPORT_OK);
11              
12              
13             use Exception::Class (
14 2         14 '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   744 );
  2         15412  
31              
32 2     2   2449 use Try::Tiny;
  2         3062  
  2         1259  
33              
34              
35             sub new {
36 2     2 1 130 my $pkg = shift;
37 2         6 bless {}, $pkg;
38             }
39              
40              
41             sub read {
42 5     5 1 2169 my ( $self, $fname ) = @_;
43 5 100       15 return if not $self->__is_file_known_or_opened($fname);
44 4 100       19 $self->filename($fname) if not exists $self->{__filehandle};
45 3 100       9 delete $self->{__records} if exists $self->{__records};
46 3         11 $self->__read_file_handle;
47 3         74 $self->__close_file;
48             }
49              
50             sub __is_file_known_or_opened {
51 5     5   9 my ( $self, $fname ) = @_;
52 5 100 100     18 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 71 my ( $self, $fname ) = @_;
60 5 50       21 $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     18 : undef;
64             }
65              
66             sub __check_and_open_file {
67 5     5   7 my ( $self, $fname ) = @_;
68 5 100 66     151 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         15 $self->__open_file($fname);
72 3         17 $self->{__filename} = $fname;
73             }
74              
75             sub __open_file {
76 3     3   6 my ( $self, $fname ) = @_;
77 3 50       7 $self->__close_file if exists $self->{__filehandle};
78 3 50       115 open my $fh, "<$fname"
79             or throw_cant_open error => "Error while opening file $fname";
80 3         12 $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         5 my $fh = $self->{__filehandle};
87 3         8 $self->__init_read_fh;
88 3         57 while (<$fh>) {
89 6         51 $self->lines_parsed( $self->lines_parsed + 1 );
90 6         12 $self->__try_to_parse($_);
91             }
92             }
93              
94             sub __init_read_fh {
95 3     3   5 my $self = shift;
96 3         16 $self->lines_parsed(0);
97 3         5 $self->{__bytes_read} = 0;
98             }
99              
100              
101             sub lines_parsed {
102 22     22 1 689 my $self = shift;
103 22 100       37 return $self->{__current_line} = shift if @_;
104 13 100       46 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   330 try { $self->save_record($line); }
110             catch {
111 0     0   0 $self->__close_file;
112 0         0 $_->rethrow;
113 6         27 };
114             }
115              
116              
117             sub save_record {
118 7     7 1 54 my $self = shift;
119 7 50       14 return if not @_;
120 7 100       24 $self->{__records} = [] if not defined $self->{__records};
121 7         8 push @{ $self->{__records} }, shift;
  7         16  
122             }
123              
124             sub __close_file {
125 3     3   4 my $self = shift;
126 3         22 close $self->{__filehandle};
127 3         17 delete $self->{__filehandle};
128             }
129              
130              
131             sub get_records {
132 5     5 1 9 my $self = shift;
133 5 100       20 return () if not exists $self->{__records};
134 4         5 return @{ $self->{__records} };
  4         17  
135             }
136              
137              
138             sub last_record {
139 6     6 1 7 my $self = shift;
140 6 100       18 return undef if not exists $self->{__records};
141 5         6 my (@record) = @{ $self->{__records} };
  5         12  
142 5         16 return $record[$#record];
143             }
144              
145              
146             sub pop_record {
147 6     6 1 31 my $self = shift;
148 6 100       14 return undef if not exists $self->{__records};
149 5         5 pop @{ $self->{__records} };
  5         15  
150             }
151              
152             1;
153              
154             __END__