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

Last change on this file was 975:de0c829662da, checked in by GomoR <gomor@…>, 13 days ago
  • update: client::elasticsearch: loop_show_reindex_progress Command to take an optional Argument
  • new: file::read: skip_comment and skip_blank_line Attributes
  • new: file::read: offset Command
  • new: file::read: read_until_ini_block Command
  • new: file::text: read_split_by_ini_block Command
  • bugfix: network::address: match command to check Arguments if they are both IPv4 or both IPv6
  • new: xorg::xrandr: get_common_resolution Command
  • new: xorg::xrandr: clone Command to make use of get_common_resolution if no resolution is given. That is, make autodetection of best resolution to use on both cloned screens
File size: 4.1 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      },
39      require_modules => {
40         'Metabrik::File::Read' => [ ],
41      },
42   };
43}
44
45sub _open {
46   my $self = shift;
47   my ($input) = @_;
48
49   my $fr = Metabrik::File::Read->new_from_brik_init($self) or return;
50   $fr->input($input);
51   $fr->encoding($self->encoding);
52   $fr->as_array($self->as_array);
53   $fr->strip_crlf($self->strip_crlf);
54
55   $fr->open or return;
56
57   return $fr;
58}
59
60#
61# Read everything available
62#
63sub read {
64   my $self = shift;
65   my ($input) = @_;
66
67   $input ||= $self->input;
68   $self->brik_help_run_undef_arg('read', $input) or return;
69
70   my $fr = $self->_open($input) or return;
71   my $data = $fr->read or return;
72   $fr->close;
73   $self->_fr(undef);
74
75   return $data;
76}
77
78#
79# Just return next available line
80#
81sub read_line {
82   my $self = shift;
83   my ($input, $count) = @_;
84
85   $input ||= $self->input;
86   $count ||= 1;
87   $self->brik_help_run_undef_arg('read_line', $input) or return;
88   $self->brik_help_run_file_not_found('read_line', $input) or return;
89
90   my $fr = $self->_fr;
91   if (! $fr) {
92      $fr = $self->_open($input) or return;
93      $self->_fr($fr);
94   }
95
96   if ($fr->eof) {
97      $fr->close;
98      $self->_fr(undef);
99      return 0;
100   }
101
102   my $data;
103   my @lines = ();
104   if ($count > 1) {
105      for (1..$count) {
106         $data = $fr->read_line;
107         push @lines, $data;
108      }
109   }
110   else {
111      $data = $fr->read_line;
112   }
113
114   return $count > 1 ? \@lines : $data;
115}
116
117#
118# Will read everything until eof
119#
120sub read_split_by_blank_line {
121   my $self = shift;
122   my ($input) = @_;
123
124   $input ||= $self->input;
125   $self->brik_help_run_undef_arg('read_split_by_blank_line', $input) or return;
126
127   my $fr = $self->_open($input) or return;
128
129   my @chunks = ();
130   while (my $this = $fr->read_until_blank_line) {
131      push @chunks, $this;
132      last if $fr->eof;
133   }
134
135   $fr->close;
136   $self->_fr(undef);
137
138   return \@chunks;
139}
140
141sub read_split_by_ini_block {
142   my $self = shift;
143   my ($input) = @_;
144
145   $input ||= $self->input;
146   $self->brik_help_run_undef_arg('read_split_by_ini_block', $input) or return;
147
148   my $fr = $self->_open($input) or return;
149   $fr->skip_comment(1);
150   $fr->skip_blank_line(1);
151
152   my @chunks = ();
153   while (my $this = $fr->read_until_ini_block) {
154      push @chunks, $this;
155      last if $fr->eof;
156   }
157
158   $fr->close;
159   $self->_fr(undef);
160
161   return \@chunks;
162}
163
164sub write {
165   my $self = shift;
166   my ($data, $output) = @_;
167
168   $output ||= $self->output;
169   $self->brik_help_run_undef_arg('write', $data) or return;
170   $self->brik_help_run_undef_arg('write', $output) or return;
171
172   $self->open($output) or return;
173   # We check definedness because if we write 0 byte write will return 0
174   my $r = $self->SUPER::write($data);
175   if (! defined($r)) {
176      return;
177   }
178   $self->close;
179
180   return 1;
181}
182
1831;
184
185__END__
186
187=head1 NAME
188
189Metabrik::File::Text - file::text Brik
190
191=head1 COPYRIGHT AND LICENSE
192
193Copyright (c) 2014-2018, Patrice E<lt>GomoRE<gt> Auffret
194
195You may distribute this module under the terms of The BSD 3-Clause License.
196See LICENSE file in the source distribution archive.
197
198=head1 AUTHOR
199
200Patrice E<lt>GomoRE<gt> Auffret
201
202=cut
Note: See TracBrowser for help on using the repository browser.