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