File Coverage

lib/Sweet/Dir.pm

Criterion	Covered	Total	%
statement	65	75	86.6
branch	9	10	90.0
condition	3	3	100.0
subroutine	19	25	76.0
pod	7	7	100.0
total	103	120	85.8

line	stmt	bran	cond	sub	pod	time	code
1							package Sweet::Dir;
2	7			7		3439676	use v5.12;
	7					20
	7					240
3	7			7		1627	use Moose;
	7					1640138
	7					43
4	7			7		33102	use namespace::autoclean;
	7					6255
	7					31
5
6	7			7		299	use Carp;
	7					9
	7					326
7	7			7		32	use Try::Tiny;
	7					9
	7					239
8
9	7			7		1431	use MooseX::Types::Path::Class;
	7					484694
	7					29
10	7			7		3880	use File::Path qw(make_path remove_tree);
	7					10
	7					340
11	7			7		32	use Try::Tiny;
	7					7
	7					262
12
13	7			7		1502	use Sweet::File;
	7					21
	7					2706
14
15							has path => (
16							builder => '_build_path',
17							coerce => 1,
18							is => 'ro',
19							isa => 'Path::Class::Dir',
20							lazy => 1,
21							);
22
23							sub create {
24	6			6	1	49	my $self = shift;
25
26	6					137	my $path = $self->path;
27
28	6					8	my $make_path_error;
29
30	6	100				11	return $self if $self->is_a_directory;
31
32							try {
33	3			3		132	make_path( $path, { error => \$make_path_error } );
34							}
35							catch {
36	0			0		0	croack $make_path_error;
37	3					58	};
38							}
39
40	1			1	1	24	sub does_not_exists { !-d shift->path }
41
42							sub erase {
43	0			0	1	0	my $self = shift;
44
45	0					0	my $path = $self->path;
46	0					0	my $remove_path_error;
47
48							try {
49	0			0		0	remove_path( $path, { error => \$remove_path_error } );
50							}
51							catch {
52	0			0		0	croack $remove_path_error;
53	0					0	};
54							}
55
56							sub file {
57	4			4	1	5	my ( $self, $name, $builder ) = @_;
58
59							my $default_builder = sub {
60	3			3		4	my ( $dir, $name ) = @_;
61
62	3					73	my $file = Sweet::File->new(
63							dir => $dir,
64							name => $name
65							);
66
67	3					7	return $file;
68	4					13	};
69
70	4	100				10	$builder = $default_builder if (not defined $builder);
71
72							my $file = try {
73	4			4		111	$builder->( $self, $name );
74							}
75							catch {
76	0			0		0	croak $_;
77	4					18	};
78
79	4					58	return $file;
80							}
81
82							sub file_list {
83	2			2	1	3	my ( $self, $regexp ) = @_;
84
85	2					49	my $path = $self->path;
86
87	2	50				8	opendir my ($dir), $path or croak "Could not open $path: $!";
88	2					99	my @file_names = grep { not m/ ^ \.\.? $ /x } readdir $dir;
	23					34
89	2					12	closedir $dir;
90
91	2	100				10	return @file_names if not defined $regexp;
92
93	1					3	return grep { m/$regexp/ } @file_names;
	14					35
94							}
95
96	13			13	1	254	sub is_a_directory { -d shift->path }
97
98							sub sub_dir {
99	5			5	1	8	my $self = shift;
100
101	5					5	my @path;
102
103	5	100	100			39	if ( scalar(@_) == 1 and ref $_[0] eq 'ARRAY' ) {
104	1					2	@path = @{ $_[0] };
	1					2
105							}
106							else {
107	4					7	@path = @_;
108							}
109
110	5					113	my $sub_dir_path = File::Spec->catfile( $self->path, @path );
111
112	5					170	my $sub_dir = Sweet::Dir->new( path => $sub_dir_path );
113
114	5					44	return $sub_dir;
115							}
116
117	7			7		1080	use overload q("") => sub { shift->path }, bool => sub { 1 }, fallback => 1;
	7			0		8
	7					526
	0					0
	0					0
118
119							__PACKAGE__->meta->make_immutable;
120
121							1;
122							__END__
123
124							=head1 NAME
125
126							Sweet::Dir
127
128							=head1 SYNOPSIS
129
130							use Sweet::Dir;
131
132							my $dir = Sweet::Dir->new(path => '/path/to/dir');
133							$dir->create;
134
135
136							say $dir; # /path/to/dir
137
138							=head1 ATTRIBUTES
139
140							=head2 path
141
142							=head1 METHODS
143
144							=head2 create
145
146							$dir->create;
147
148							=head2 does_not_exists
149
150							$dir->create if $dir->does_not_exists;
151
152							=head2 erase
153
154							$dir->erase;
155
156							=head2 file
157
158							Instance of file inside dir. Returns a L<Sweet::File> by default.
159
160							my $file = $dir->file('foo.txt');
161							say $file; # /path/to/dir/foo.txt
162
163							Accepts an optional reference to a sub which expects C<$dir> and C<$name>
164							parameters and will be called to build the object reference. For example
165
166							use Sweet::File::DSV;
167
168							my $file = $dir->file('bar.tsv', sub {
169							my ( $dir, $name ) = @_;
170
171							my $file = Sweet::File::DSV->new(
172							dir => $dir,
173							name => $name,
174							separator => "\t",
175							);
176
177							return $file;
178							});
179
180							=head2 file_list
181
182							Returns a list of files contained in the directory
183
184							my @files = @$dir->file_list;
185
186							=head2 is_a_directory
187
188							# Create dir if it does not exists.
189							$dir->is_a_directory or $dir->create;
190
191							=head2 sub_dir
192
193							my $dir2 = $dir->sub_dir('foo', bar');
194							# Or pass an arrayref if you prefer.
195							# my $dir2 = $dir->sub_dir(['foo', bar']);
196
197							# Create foo/bar sub directory.
198							$dir2->create;
199
200							=cut
201
202