File Coverage

lib/Sweet/File.pm

Criterion	Covered	Total	%
statement	108	114	94.7
branch	6	6	100.0
condition			n/a
subroutine	33	38	86.8
pod	11	11	100.0
total	158	169	93.4

line	stmt	bran	sub	pod	time	code
1						package Sweet::File;
2	11		11		533189	use v5.12;
	11				38
	11				358
3	11		11		331	use Moose;
	11				273317
	11				43
4	11		11		41201	use namespace::autoclean;
	11				1017
	11				46
5
6	11		11		431	use Carp;
	11				23
	11				465
7	11		11		44	use Try::Tiny;
	11				12
	11				380
8
9	11		11		42	use File::Basename;
	11				22
	11				609
10	11		11		961	use File::Copy;
	11				6653
	11				468
11	11		11		2195	use File::Remove 'remove';
	11				15083
	11				520
12	11		11		55	use File::Spec;
	11				22
	11				76
13	11		11		117	use Moose::Util::TypeConstraints;
	11				15
	11				59
14	11		11		14076	use MooseX::Types::Path::Class;
	11				264610
	11				55
15	11		11		7878	use Sweet::Types;
	11				24
	11				62
16	11		11		5683	use Storable qw(dclone);
	11				23082
	11				11000
17
18						sub BUILDARGS {
19	17		17	1	40	my ($class, %attribute) = @_;
20
21	17				21	my $lines_arrayref = $attribute{lines};
22
23						# Needed 'cause init_arg does not work with Array trait.
24	17	100			30	if (defined $lines_arrayref) {
25						# Avoid use an external reference to store an attribute.
26	1				72	$attribute{_lines} = dclone($lines_arrayref);
27
28	1				3	delete $attribute{lines};
29						}
30
31	17				348	return \%attribute;
32						}
33
34						my $output = sub {
35						my ($mode, $layer, $path, $lines_arrayref) = @_;
36
37						open my $fh, $mode.$layer, $path or croak "Couldn't open $path: $!";
38						$fh->autoflush(1);
39						say $fh $_ for @{$lines_arrayref};
40						close $fh or croak "Couldn't close $path: $!";
41						};
42
43						my $input = sub {
44						my ($layer, $path) = @_;
45
46						open my $fh, "<:$layer", $path or croak "Couldn't open $path: $!";
47						my @lines =<$fh>;
48						close $fh or croak "Couldn't close $path: $!";
49
50						chomp @lines;
51
52						return \@lines;
53						};
54
55						has _lines => (
56						builder => '_build_lines',
57						handles => {
58						add_lines => 'push',
59						lines => 'elements',
60						line => 'get',
61						num_lines => 'count',
62						},
63						is => 'ro',
64						isa => 'ArrayRef[Str]',
65						lazy => 1,
66						traits => ['Array'],
67						);
68
69						sub _build_lines {
70	5		5		7	my $self = shift;
71
72	5				100	my $encoding = $self->encoding;
73	5				88	my $path = $self->path;
74
75	5				13	my $lines = $input->($encoding, $path);
76
77	5				158	return $lines;
78						}
79
80						has dir => (
81						builder => '_build_dir',
82						coerce => 1,
83						is => 'ro',
84						isa => 'Sweet::Dir',
85						lazy => 1,
86						predicate => 'has_dir',
87						);
88
89						sub _build_dir {
90	1		1		2	my $self = shift;
91
92	1				19	my $path = $self->path;
93
94	1				9	my $dirname = dirname($path);
95
96	1				73	my $dir = Sweet::Dir->new(path => $dirname);
97
98	1				18	return $dir;
99						}
100
101						# TODO see Encode::Supported
102						my @encodings = qw(utf8);
103
104						has encoding => (
105						default => sub { 'utf8' },
106						is => 'ro',
107						isa => enum(\@encodings),
108						required => 1,
109						);
110
111						has name => (
112						builder => '_build_name',
113						is => 'ro',
114						isa => 'Str',
115						lazy => 1,
116						);
117
118						sub _build_name {
119	1		1		2	my $self = shift;
120
121	1				18	my $path = $self->path;
122
123	1				21	my $name = basename($path);
124
125	1				81	return $name;
126						}
127
128						has extension => (
129						builder => '_build_extension',
130						is => 'ro',
131						isa => 'Str',
132						lazy => 1,
133						);
134
135						sub _build_extension {
136	1		1		22	my $path = shift->path;
137
138	1				11	my ($filename, $dirname, $suffix) = fileparse($path, qr/[^.]*$/);
139
140	1				116	return $suffix;
141						}
142
143						has path => (
144						builder => '_build_path',
145						coerce => 1,
146						is => 'ro',
147						isa => 'Path::Class::File',
148						lazy => 1,
149						);
150
151						sub _build_path {
152	19		19		23	my $self = shift;
153
154	19				355	my $name = $self->name;
155	19				341	my $dir = $self->dir;
156
157	19				340	my $dir_path = $dir->path;
158
159	19				134	my $path = File::Spec->catfile($dir_path, $name);
160
161	19				652	return $path;
162						}
163
164						sub append {
165	1		1	1	2	my ($self, $lines_arrayref) = @_;
166
167	1				2	my @lines = @$lines_arrayref;
168
169	1				29	$self->add_lines(@lines);
170
171	1				20	my $encoding = $self->encoding;
172	1				19	my $path = $self->path;
173
174	1				4	$output->('>>', $encoding, $path, $lines_arrayref);
175						}
176
177						sub copy_to_dir {
178	5		5	1	7	my ($self, $dir) = @_;
179
180	5				104	my $name = $self->name;
181
182	5				12	my $class = $self->meta->name;
183
184						my $file_copied = try {
185	5		5		246	$class->new(dir => $dir, name => $name);
186						}
187						catch {
188	0		0		0	croak $_;
189	5				151	};
190
191	5				181	my $source_path = $self->path;
192	5				90	my $target_path = $file_copied->path;
193	5				91	$dir = $file_copied->dir;
194
195						try {
196	5	100	5		119	$dir->is_a_directory or $dir->create;
197						}
198						catch {
199	0		0		0	croak $_;
200	5				27	};
201
202						try {
203	5		5		108	copy($source_path, $target_path);
204						}
205						catch {
206	0		0		0	croak $_;
207	5				341	};
208
209	5				2696	return $file_copied;
210						}
211
212	4		4	1	89	sub does_not_exists { !-e shift->path }
213
214	0		0	1	0	sub erase { remove(shift->path) }
215
216	1		1	1	22	sub has_zero_size { -z shift->path }
217
218	11		11	1	304	sub is_a_plain_file { -f shift->path }
219
220	0		0	1	0	sub is_executable { -x shift->path }
221
222	1		1	1	23	sub is_writable { -w shift->path }
223
224						sub split_line {
225	5		5	1	6	my $self = shift;
226
227						return sub {
228	5		5		5	my $pattern = shift;
229
230						# If pattern is a pipe, escape it.
231	5	100			12	$pattern = '\\|' if ($pattern eq '\|');
232
233						return sub {
234	5				7	my $num_line = shift;
235
236	5				132	my $line = $self->line($num_line);
237
238	5				55	return split $pattern, $line;
239						}
240	5				13	}
241	5				18	}
242
243						sub write {
244	2		2	1	2	my $self = shift;
245
246	2				48	my $encoding = $self->encoding;
247	2				39	my $lines_arrayref = $self->_lines;
248	2				38	my $path = $self->path;
249
250	2				6	$output->('>', $encoding, $path, $lines_arrayref);
251						}
252
253	11		11		73	use overload q("") => sub { shift->path }, bool => sub { 1 }, fallback => 1;
	11		1		12
	11				632
	1				23
	0				0
254
255						__PACKAGE__->meta->make_immutable;
256
257						1;
258						__END__
259
260						=head1 NAME
261
262						Sweet::File
263
264						=head1 SYNOPSIS
265
266						use Sweet::File;
267
268						my $file1 = Sweet::File->new(
269						dir => '/path/to/dir',
270						name => 'foo',
271						);
272
273						my $file2 = Sweet::File->new(path => '/path/to/file');
274
275						=head1 ATTRIBUTES
276
277						=head2 dir
278
279						Instance of L<Sweet::Dir>.
280
281						=head2 encoding
282
283						Defaults to C<utf8>.
284
285						=head2 extension
286
287						=head2 name
288
289						=head2 path
290
291						=head1 PRIVATE ATTRIBUTES
292
293						=head2 _lines
294
295						=head1 METHODS
296
297						=head2 append
298
299						Append lines to a file.
300
301						my @lines = ('first appended line', 'second appended line');
302
303						$file->append(\@lines);
304
305						=head2 copy_to_dir
306
307						Copy file to a directory.
308
309						$file->copy_to_dir($dir);
310
311						Coerces path to L<Sweet::Dir>.
312
313						$file->copy_to_dir('/path/to/dir');
314
315						Coerces C<ArrayRef> to L<Sweet::Dir>.
316
317						$file->copy_to_dir(['/path/to', 'dir']);
318
319						=head2 does_not_exists
320
321						The negation of the C<-e> flag in natural language.
322
323						=head2 erase
324
325						Removes file, using L<File::Remove>.
326
327						$file->erase
328
329						=head2 has_zero_size
330
331						The C<-z> flag in natural language.
332
333						$file->has_zero_size
334
335						=head2 is_a_plain_file
336
337						The C<-f> flag in natural language.
338
339						$file->is_a_plain_file
340
341						=head2 is_executable
342
343						The C<-x> flag in natural language.
344
345						$file->is_executable
346
347						=head2 is_writable
348
349						The C<-w> flag in natural language.
350
351						$file->is_writable
352
353						=head2 line
354
355						Returns the nth line.
356
357						my $line1 = $file->line(0);
358						my $line2 = $file->line(1);
359						my $line3 = $file->line(2);
360
361						=head2 lines
362
363						for my $line ( $file->lines ) {
364						$line =~ s/foo/bar/;
365						say $line;
366						}
367
368						=head2 num_lines
369
370						say $file->num_lines if $file->is_a_plain_file;
371
372						=head2 split_line
373
374						Get first line splitted on pipe.
375
376						my @parts = $file->split_line->('\|')->(0);
377
378						Split lines on comma.
379
380						my $splitted_line = $file->split_line->(',');
381						my @parts0 = $splitted_line->(0);
382						my @parts1 = $splitted_line->(1);
383
384						=head2 write
385
386						Write lines to a brand new file.
387
388						my @lines = ('first line', 'second line');
389
390						my $file = Sweet::File->new(
391						name => 'brand_new_file.txt',
392						dir => $dir,
393						lines => \@lines,
394						);
395
396						$file->write;
397
398						=head1 PRIVATE METHODS
399
400						=head2 _build_lines
401
402						The L</lines> builder. To be overridden in subclasses, if needed.
403
404						=head2 _build_dir
405
406						The L</dir> builder. To be overridden in subclasses, if needed.
407
408						=head2 _build_name
409
410						The L</name> builder. To be overridden in subclasses, if needed.
411
412						=head2 _build_extension
413
414						The L</extension> builder. To be overridden in subclasses, if needed.
415
416						=head2 _build_path
417
418						The L</path> builder. To be overridden in subclasses, if needed.
419
420						=cut
421
422