source: repository/lib/Metabrik/File/Text.pm

tip
Last change on this file was 1004:30da8fb54fbb, checked in by GomoR <gomor@…>, 10 hours ago
  • new: file::text: is_eof Command
File size: 4.3 KB
Line 
1#
2# $Id$
3#
4# file::text Brik
5#
6package Metabrik::File::Text;
7use strict;
8use warnings;
9
10use base qw(Metabrik::File::Write);
11
12sub brik_properties {
13   return {
14      revision => '$Revision$',
15      tags => [ qw(unstable read write) ],
16      author => 'GomoR <GomoR[at]metabrik.org>',
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
46sub _open {
47   my $self = shift;
48   my ($input) = @_;
49
50   my $fr = Metabrik::File::Read->new_from_brik_init($self) or return;
51   $fr->input($input);
52   $fr->encoding($self->encoding);
53   $fr->as_array($self->as_array);
54   $fr->strip_crlf($self->strip_crlf);
55
56   $fr->open or return;
57
58   return $fr;
59}
60
61#
62# Read everything available
63#
64sub read {
65   my $self = shift;
66   my ($input) = @_;
67
68   $input ||= $self->input;
69   $self->brik_help_run_undef_arg('read', $input) or return;
70
71   my $fr = $self->_open($input) or return;
72   my $data = $fr->read or return;
73   $fr->close;
74   $self->_fr(undef);
75
76   return $data;
77}
78
79#
80# Just return next available line
81# Returns 0 on EOF.
82#
83sub read_line {
84   my $self = shift;
85   my ($input, $count) = @_;
86
87   $input ||= $self->input;
88   $count ||= 1;
89   $self->brik_help_run_undef_arg('read_line', $input) or return;
90   $self->brik_help_run_file_not_found('read_line', $input) or return;
91
92   my $fr = $self->_fr;
93   if (! $fr) {
94      $fr = $self->_open($input) or return;
95      $self->_fr($fr);
96   }
97
98   if ($fr->eof) {
99      $fr->close;
100      $self->_fr(undef);
101      return 0;
102   }
103
104   my $data;
105   my @lines = ();
106   if ($count > 1) {
107      for (1..$count) {
108         $data = $fr->read_line;
109         push @lines, $data;
110      }
111   }
112   else {
113      $data = $fr->read_line;
114   }
115
116   return $count > 1 ? \@lines : $data;
117}
118
119#
120# Will read everything until eof
121#
122sub read_split_by_blank_line {
123   my $self = shift;
124   my ($input) = @_;
125
126   $input ||= $self->input;
127   $self->brik_help_run_undef_arg('read_split_by_blank_line', $input) or return;
128
129   my $fr = $self->_open($input) or return;
130
131   my @chunks = ();
132   while (my $this = $fr->read_until_blank_line) {
133      push @chunks, $this;
134      last if $fr->eof;
135   }
136
137   $fr->close;
138   $self->_fr(undef);
139
140   return \@chunks;
141}
142
143sub read_split_by_ini_block {
144   my $self = shift;
145   my ($input) = @_;
146
147   $input ||= $self->input;
148   $self->brik_help_run_undef_arg('read_split_by_ini_block', $input) or return;
149
150   my $fr = $self->_open($input) or return;
151   $fr->skip_comment(1);
152   $fr->skip_blank_line(1);
153
154   my @chunks = ();
155   while (my $this = $fr->read_until_ini_block) {
156      push @chunks, $this;
157      last if $fr->eof;
158   }
159
160   $fr->close;
161   $self->_fr(undef);
162
163   return \@chunks;
164}
165
166sub write {
167   my $self = shift;
168   my ($data, $output) = @_;
169
170   $output ||= $self->output;
171   $self->brik_help_run_undef_arg('write', $data) or return;
172   $self->brik_help_run_undef_arg('write', $output) or return;
173
174   $self->open($output) or return;
175   # We check definedness because if we write 0 byte write will return 0
176   my $r = $self->SUPER::write($data);
177   if (! defined($r)) {
178      return;
179   }
180   $self->close;
181
182   return 1;
183}
184
185sub is_eof {
186   my $self = shift;
187   my ($r) = @_;
188
189   if (defined($r) && $r == 0 && !defined($self->_fr)) {
190      return 1;
191   }
192
193   return 0;
194}
195
1961;
197
198__END__
199
200=head1 NAME
201
202Metabrik::File::Text - file::text Brik
203
204=head1 COPYRIGHT AND LICENSE
205
206Copyright (c) 2014-2019, Patrice E<lt>GomoRE<gt> Auffret
207
208You may distribute this module under the terms of The BSD 3-Clause License.
209See LICENSE file in the source distribution archive.
210
211=head1 AUTHOR
212
213Patrice E<lt>GomoRE<gt> Auffret
214
215=cut
Note: See TracBrowser for help on using the repository browser.