File Coverage

blib/lib/File/Find/Object/PathComp.pm
Criterion Covered Total %
statement 48 51 94.1
branch 6 6 100.0
condition 3 6 50.0
subroutine 13 14 92.8
pod n/a
total 70 77 90.9


line stmt bran cond sub pod time code
1             package File::Find::Object::PathComp;
2             $File::Find::Object::PathComp::VERSION = '0.3.7';
3 5     5   2517 use strict;
  5         15  
  5         163  
4 5     5   29 use warnings;
  5         9  
  5         122  
5              
6 5     5   23 use integer;
  5         10  
  5         44  
7              
8 5     5   125 use parent 'File::Find::Object::Base';
  5         9  
  5         35  
9              
10             use Class::XSAccessor accessors => {
11             (
12 5         13 map { $_ => $_ } (
  35         111  
13             qw(
14             _actions
15             _curr_file
16             _files
17             _last_dir_scanned
18             _open_dir_ret
19             _stat_ret
20             _traverse_to
21             )
22             )
23             )
24             },
25             getters => { _inodes => '_inodes' },
26             setters => { _set_inodes => '_inodes' },
27 5     5   426 ;
  5         14  
28              
29 5     5   2609 use File::Spec;
  5         12  
  5         2256  
30              
31             __PACKAGE__->_make_copy_methods(
32             [
33             qw(
34             _files
35             _traverse_to
36             )
37             ]
38             );
39              
40             sub _dev
41             {
42 88     88   387 return shift->_stat_ret->[0];
43             }
44              
45             sub _inode
46             {
47 71     71   269 return shift->_stat_ret->[1];
48             }
49              
50             sub _is_same_inode
51             {
52 0     0   0 my $self = shift;
53              
54             # $st is an array ref with the return of perldoc -f stat .
55 0         0 my $st = shift;
56              
57             # On MS-Windows, all inodes in stat are returned as 0, so we need to
58             # check that both inodes are not zero. This is why there's the
59             # $self->_inode() != 0 check at the end.
60 0   0     0 return ( $self->_dev() == $st->[0]
61             && $self->_inode() == $st->[1]
62             && $self->_inode() != 0 );
63             }
64              
65             sub _should_scan_dir
66             {
67 64     64   99 my $self = shift;
68 64         88 my $dir_str = shift;
69              
70 64 100 100     272 if ( defined( $self->_last_dir_scanned() )
71             && ( $self->_last_dir_scanned() eq $dir_str ) )
72             {
73 7         19 return;
74             }
75             else
76             {
77 57         143 $self->_last_dir_scanned($dir_str);
78 57         141 return 1;
79             }
80             }
81              
82             sub _set_up_dir
83             {
84 57     57   89 my $self = shift;
85 57         82 my $dir_str = shift;
86              
87 57         140 $self->_files( $self->_calc_dir_files($dir_str) );
88              
89 57         231 $self->_traverse_to( $self->_files_copy() );
90              
91 57         384 return $self->_open_dir_ret(1);
92             }
93              
94             sub _calc_dir_files
95             {
96 57     57   79 my $self = shift;
97 57         81 my $dir_str = shift;
98              
99 57         96 my $handle;
100             my @files;
101 57 100       1807 if ( !opendir( $handle, $dir_str ) )
102             {
103             # Handle this error gracefully.
104             }
105             else
106             {
107             @files =
108 54         1823 ( sort { $a cmp $b } File::Spec->no_upwards( readdir($handle) ) );
  54         171  
109 54         643 closedir($handle);
110             }
111              
112 57         446 return \@files;
113             }
114              
115             sub _component_open_dir
116             {
117 64     64   114 my $self = shift;
118 64         105 my $dir_str = shift;
119              
120 64 100       157 if ( !$self->_should_scan_dir($dir_str) )
121             {
122 7         30 return $self->_open_dir_ret();
123             }
124              
125 57         144 return $self->_set_up_dir($dir_str);
126             }
127              
128             sub _next_traverse_to
129             {
130 115     115   186 my $self = shift;
131              
132 115         152 return shift( @{ $self->_traverse_to() } );
  115         414  
133             }
134              
135             1;
136              
137             __END__