File Coverage

blib/lib/File/Object.pm
Criterion Covered Total %
statement 132 132 100.0
branch 42 42 100.0
condition 17 17 100.0
subroutine 18 18 100.0
pod 9 9 100.0
total 218 218 100.0


line stmt bran cond sub pod time code
1             package File::Object;
2              
3 11     11   107807 use strict;
  11         82  
  11         340  
4 11     11   63 use warnings;
  11         27  
  11         300  
5              
6 11     11   4936 use Class::Utils qw(set_params);
  11         108422  
  11         209  
7 11     11   732 use Error::Pure qw(err);
  11         30  
  11         437  
8 11     11   4915 use File::Spec::Functions qw(catdir catfile splitdir);
  11         9588  
  11         768  
9 11     11   5064 use FindBin qw($Bin $Script);
  11         21457  
  11         19963  
10              
11             our $VERSION = 0.18;
12              
13             # Constructor.
14             sub new {
15 39     39 1 19371 my ($class, @params) = @_;
16              
17             # Create object.
18 39         104 my $self = bless {}, $class;
19              
20             # Directory path.
21 39         120 $self->{'dir'} = [];
22              
23             # File path.
24 39         81 $self->{'file'} = undef;
25              
26             # Type of path.
27 39         71 $self->{'type'} = 'dir';
28              
29             # Process parameters.
30 39         146 set_params($self, @params);
31              
32             # Check to right 'type'.
33 37 100 100     820 if (! $self->{'type'} || ($self->{'type'} ne 'file'
      100        
34             && $self->{'type'} ne 'dir')) {
35              
36 2         9 err 'Bad \'type\' parameter.';
37             }
38              
39             # Check to dir.
40 35 100       115 if (ref $self->{'dir'} ne 'ARRAY') {
41 1         3 err '\'dir\' parameter must be a reference to array.';
42             }
43              
44             # Check to file.
45 34 100 100     115 if ($self->{'type'} eq 'file' && @{$self->{'dir'}}
  15   100     102  
46             && ! defined $self->{'file'}) {
47              
48 1         6 err 'Bad file constructor with undefined \'file\' parameter.';
49             }
50              
51             # Remove undef dirs.
52 33 100       54 if (@{$self->{'dir'}}) {
  33         102  
53 20 100       49 my @dir = map { defined $_ ? $_ : () } @{$self->{'dir'}};
  34         107  
  20         54  
54 20         53 $self->{'dir'} = \@dir;
55             }
56              
57             # Update path.
58 33         123 $self->_update_path;
59              
60             # Set values.
61 33         87 $self->set;
62              
63             # Object.
64 33         142 return $self;
65             }
66              
67             # Add dir.
68             sub dir {
69 17     17 1 43 my ($self, @dirs) = @_;
70              
71 17         30 foreach my $dir (@dirs) {
72 8 100       23 if (defined $dir) {
73 6         15 $self->_dir($dir);
74             }
75             }
76              
77             # Object.
78 17         30 return $self;
79             }
80              
81             # Add file.
82             sub file {
83 12     12 1 49 my ($self, @file_path) = @_;
84              
85 12         20 my $file = pop @file_path;
86 12         32 $self->dir(@file_path);
87 12         29 $self->_file($file);
88              
89 12         30 return $self;
90             }
91              
92              
93             # Get dir.
94             sub get_dir {
95 12     12 1 1940 my ($self, $dir_num) = @_;
96              
97 12   100     51 $dir_num ||= 1;
98 12 100       28 if ($self->{'type'} eq 'file') {
99 3         4 $dir_num++;
100             }
101              
102 12         56 return $self->{'path'}->[-$dir_num];
103             }
104              
105             # Get file.
106             sub get_file {
107 2     2 1 8 my $self = shift;
108              
109 2 100       5 if ($self->{'type'} eq 'file') {
110 1         4 return $self->{'path'}->[-1];
111             } else {
112 1         3 return;
113             }
114             }
115              
116             # Reset to constructor values.
117             sub reset {
118 10     10 1 23 my $self = shift;
119              
120             # Reset to setted values.
121 10         23 $self->{'dir'} = $self->{'_set'}->{'dir'};
122 10         20 $self->{'file'} = $self->{'_set'}->{'file'};
123 10         17 $self->{'type'} = $self->{'_set'}->{'type'};
124              
125             # Update path.
126 10         23 $self->_update_path;
127              
128 10         22 return $self;
129             }
130              
131             # Serialize path.
132             sub s {
133 34     34 1 121 my $self = shift;
134              
135 34 100       86 if ($self->{'type'} eq 'dir') {
136 15         23 return catdir(@{$self->{'path'}});
  15         124  
137             } else {
138 19         25 return catfile(@{$self->{'path'}});
  19         170  
139             }
140             }
141              
142             # Set actual values to constructor values.
143             sub set {
144 35     35 1 58 my $self = shift;
145              
146 35         49 my @path = @{$self->{'path'}};
  35         97  
147 35         89 $self->{'_set'}->{'type'} = $self->{'type'};
148 35 100       83 if ($self->{'type'} eq 'file') {
149 15         31 $self->{'_set'}->{'file'} = pop @path;
150 15         31 $self->{'_set'}->{'dir'} = \@path;
151             } else {
152 20         39 $self->{'_set'}->{'dir'} = \@path;
153             }
154              
155 35         65 return $self;
156             }
157              
158             # Go to parent directory.
159             sub up {
160 9     9 1 33 my ($self, $up_num) = @_;
161              
162             # Check number and positive number.
163 9 100 100     40 if (! $up_num || $up_num !~ m/^\d$/ms) {
164 7         12 $up_num = 1;
165             }
166              
167             # Process.
168 9         26 foreach (1 .. $up_num) {
169 10 100       20 if ($self->{'type'} eq 'file') {
170 2 100       4 if (@{$self->{'path'}} > 2) {
  2         7  
171 1         2 $self->{'type'} = 'dir';
172 1         2 $self->{'file'} = undef;
173 1         2 splice @{$self->{'path'}}, -2;
  1         4  
174             } else {
175 1         3 err 'Cannot go up.', 'PATH', $self->s;
176             }
177             } else {
178 8 100       11 if (@{$self->{'path'}}) {
  8         18  
179 7         9 pop @{$self->{'path'}};
  7         20  
180             } else {
181 1         4 err 'Cannot go up.', 'PATH', $self->s;
182             }
183             }
184             }
185              
186             # Object.
187 7         20 return $self;
188             }
189              
190             # Add dir array.
191             sub _dir {
192 6     6   17 my ($self, @dir) = @_;
193              
194 6 100       22 if ($self->{'type'} eq 'file') {
195 1         2 $self->{'type'} = 'dir';
196 1         2 $self->{'file'} = undef;
197 1         2 pop @{$self->{'path'}};
  1         2  
198             }
199 6         8 push @{$self->{'path'}}, @dir;
  6         20  
200              
201 6         14 return;
202             }
203              
204             # Add file array.
205             sub _file {
206 12     12   23 my ($self, $file) = @_;
207              
208 12 100       30 if (! defined $file) {
209 1         2 return;
210             }
211 11 100       30 if ($self->{'type'} eq 'file') {
212 6         10 pop @{$self->{'path'}};
  6         14  
213 6         9 push @{$self->{'path'}}, $file;
  6         13  
214             } else {
215 5         7 push @{$self->{'path'}}, $file;
  5         13  
216 5         9 $self->{'type'} = 'file';
217             }
218              
219 11         25 return;
220             }
221              
222             # Update path.
223             sub _update_path {
224 43     43   84 my $self = shift;
225              
226 43 100       109 if ($self->{'type'} eq 'file') {
227             $self->{'path'} = [
228 17         76 @{$self->{'dir'}},
229 17 100       42 defined $self->{'file'} ? $self->{'file'} : (),
230             ];
231 17 100       33 if (! @{$self->{'path'}}) {
  17         50  
232 2         18 $self->{'path'} = [splitdir($Bin), $Script];
233             }
234             } else {
235 26         47 $self->{'path'} = [@{$self->{'dir'}}];
  26         82  
236 26 100       39 if (! @{$self->{'path'}}) {
  26         151  
237 10         49 $self->{'path'} = [splitdir($Bin)];
238             }
239             }
240              
241 43         190 return;
242             }
243              
244             1;
245              
246             __END__