File Coverage

blib/lib/Metabrik/File/Text.pm
Criterion Covered Total %
statement 9 92 9.7
branch 0 46 0.0
condition 0 23 0.0
subroutine 3 11 27.2
pod 1 7 14.2
total 13 179 7.2


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # file::text Brik
5             #
6             package Metabrik::File::Text;
7 5     5   42 use strict;
  5         10  
  5         140  
8 5     5   25 use warnings;
  5         15  
  5         132  
9              
10 5     5   25 use base qw(Metabrik::File::Write);
  5         14  
  5         2872  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable read write) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             input => [ qw(file) ],
20             output => [ qw(file) ],
21             as_array => [ qw(0|1) ],
22             strip_crlf => [ qw(0|1) ],
23             encoding => [ qw(utf8|ascii) ], # Inherited
24             _fr => [ qw(INTERNAL) ],
25             },
26             # encoding: see `perldoc Encode::Supported' for other types
27             attributes_default => {
28             encoding => 'utf8',
29             as_array => 0,
30             strip_crlf => 0,
31             },
32             commands => {
33             read => [ qw(input) ],
34             read_line => [ qw(input count|OPTIONAL) ],
35             read_split_by_blank_line => [ qw(input) ],
36             read_split_by_ini_block => [ qw(input) ],
37             write => [ qw($data|$data_ref|$data_list output) ],
38             is_eof => [ qw(ret) ],
39             },
40             require_modules => {
41             'Metabrik::File::Read' => [ ],
42             },
43             };
44             }
45              
46             sub _open {
47 0     0     my $self = shift;
48 0           my ($input) = @_;
49              
50 0 0         my $fr = Metabrik::File::Read->new_from_brik_init($self) or return;
51 0           $fr->input($input);
52 0           $fr->encoding($self->encoding);
53 0           $fr->as_array($self->as_array);
54 0           $fr->strip_crlf($self->strip_crlf);
55              
56 0 0         $fr->open or return;
57              
58 0           return $fr;
59             }
60              
61             #
62             # Read everything available
63             #
64             sub read {
65 0     0 0   my $self = shift;
66 0           my ($input) = @_;
67              
68 0   0       $input ||= $self->input;
69 0 0         $self->brik_help_run_undef_arg('read', $input) or return;
70              
71 0 0         my $fr = $self->_open($input) or return;
72 0 0         my $data = $fr->read or return;
73 0           $fr->close;
74 0           $self->_fr(undef);
75              
76 0           return $data;
77             }
78              
79             #
80             # Just return next available line
81             # Returns 0 on EOF.
82             #
83             sub read_line {
84 0     0 0   my $self = shift;
85 0           my ($input, $count) = @_;
86              
87 0   0       $input ||= $self->input;
88 0   0       $count ||= 1;
89 0 0         $self->brik_help_run_undef_arg('read_line', $input) or return;
90 0 0         $self->brik_help_run_file_not_found('read_line', $input) or return;
91              
92 0           my $fr = $self->_fr;
93 0 0         if (! $fr) {
94 0 0         $fr = $self->_open($input) or return;
95 0           $self->_fr($fr);
96             }
97              
98 0 0         if ($fr->eof) {
99 0           $fr->close;
100 0           $self->_fr(undef);
101 0           return 0;
102             }
103              
104 0           my $data;
105 0           my @lines = ();
106 0 0         if ($count > 1) {
107 0           for (1..$count) {
108 0           $data = $fr->read_line;
109 0           push @lines, $data;
110             }
111             }
112             else {
113 0           $data = $fr->read_line;
114             }
115              
116 0 0         return $count > 1 ? \@lines : $data;
117             }
118              
119             #
120             # Will read everything until eof
121             #
122             sub read_split_by_blank_line {
123 0     0 0   my $self = shift;
124 0           my ($input) = @_;
125              
126 0   0       $input ||= $self->input;
127 0 0         $self->brik_help_run_undef_arg('read_split_by_blank_line', $input) or return;
128              
129 0 0         my $fr = $self->_open($input) or return;
130              
131 0           my @chunks = ();
132 0           while (my $this = $fr->read_until_blank_line) {
133 0           push @chunks, $this;
134 0 0         last if $fr->eof;
135             }
136              
137 0           $fr->close;
138 0           $self->_fr(undef);
139              
140 0           return \@chunks;
141             }
142              
143             sub read_split_by_ini_block {
144 0     0 0   my $self = shift;
145 0           my ($input) = @_;
146              
147 0   0       $input ||= $self->input;
148 0 0         $self->brik_help_run_undef_arg('read_split_by_ini_block', $input) or return;
149              
150 0 0         my $fr = $self->_open($input) or return;
151 0           $fr->skip_comment(1);
152 0           $fr->skip_blank_line(1);
153              
154 0           my @chunks = ();
155 0           while (my $this = $fr->read_until_ini_block) {
156 0           push @chunks, $this;
157 0 0         last if $fr->eof;
158             }
159              
160 0           $fr->close;
161 0           $self->_fr(undef);
162              
163 0           return \@chunks;
164             }
165              
166             sub write {
167 0     0 0   my $self = shift;
168 0           my ($data, $output) = @_;
169              
170 0   0       $output ||= $self->output;
171 0 0         $self->brik_help_run_undef_arg('write', $data) or return;
172 0 0         $self->brik_help_run_undef_arg('write', $output) or return;
173              
174 0 0         $self->open($output) or return;
175             # We check definedness because if we write 0 byte write will return 0
176 0           my $r = $self->SUPER::write($data);
177 0 0         if (! defined($r)) {
178 0           return;
179             }
180 0           $self->close;
181              
182 0           return 1;
183             }
184              
185             sub is_eof {
186 0     0 0   my $self = shift;
187 0           my ($r) = @_;
188              
189 0 0 0       if (defined($r) && $r == 0 && !defined($self->_fr)) {
      0        
190 0           return 1;
191             }
192              
193 0           return 0;
194             }
195              
196             1;
197              
198             __END__