File Coverage

blib/lib/exact/me.pm
Criterion Covered Total %
statement 29 31 93.5
branch 6 8 75.0
condition 1 3 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 44 50 88.0


line stmt bran cond sub pod time code
1             package exact::me;
2             # ABSTRACT: Original program path locations extension for exact
3              
4 2     2   501556 use 5.014;
  2         11  
5 2     2   813 use exact;
  2         69743  
  2         20  
6 2     2   6840 use FindBin;
  2         3829  
  2         466  
7              
8             our $VERSION = '1.07'; # VERSION
9              
10             sub import {
11 1     1   28 my ( $self, $params, $caller ) = @_;
12 1   33     6 $caller //= caller();
13              
14             {
15 2     2   18 no strict 'refs';
  2         5  
  2         1808  
  1         2  
16 1 50       2 *{ $caller . '::me' } = \&me unless ( defined &{ $caller . '::me' } );
  1         6  
  1         8  
17             }
18             }
19              
20             sub me {
21 3     3 1 339528 my ($path) = @_;
22              
23 3 100       19 unless ($path) {
    100          
24 1         3 return $FindBin::Bin;
25             }
26 0         0 elsif ( index( $path, '.', 0 ) == 0 ) {
27 1         9 return $FindBin::Bin . '/' . $path;
28             }
29             else {
30 1         5 return _find_dir($path);
31             }
32              
33 0         0 return;
34             }
35              
36             sub _find_dir {
37 1     1   4 my ($suffix) = @_;
38              
39 1         6 my @search_path = split( '/', $FindBin::Bin );
40 1         7 while ( @search_path > 0 ) {
41 6         23 my $dir = join( '/', @search_path, $suffix );
42 6 50       670 return $dir if ( -d $dir );
43 6         32 pop @search_path;
44             }
45              
46 1         7 return;
47             }
48              
49             1;
50              
51             __END__