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   510509 use 5.014;
  2         10  
5 2     2   817 use exact;
  2         59735  
  2         19  
6 2     2   7659 use FindBin;
  2         3542  
  2         411  
7              
8             our $VERSION = '1.06'; # VERSION
9              
10             sub import {
11 1     1   32 my ( $self, $params, $caller ) = @_;
12 1   33     6 $caller //= caller();
13              
14             {
15 2     2   17 no strict 'refs';
  2         7  
  2         1705  
  1         2  
16 1 50       2 *{ $caller . '::me' } = \&me unless ( defined &{ $caller . '::me' } );
  1         6  
  1         10  
17             }
18             }
19              
20             sub me {
21 3     3 1 323129 my ($path) = @_;
22              
23 3 100       19 unless ($path) {
    100          
24 1         9 return $FindBin::Bin;
25             }
26 0         0 elsif ( index( $path, '.', 0 ) == 0 ) {
27 1         4 return $FindBin::Bin . '/' . $path;
28             }
29             else {
30 1         4 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         8 my @search_path = split( '/', $FindBin::Bin );
40 1         6 while ( @search_path > 0 ) {
41 6         20 my $dir = join( '/', @search_path, $suffix );
42 6 50       413 return $dir if ( -d $dir );
43 6         28 pop @search_path;
44             }
45              
46 1         6 return;
47             }
48              
49             1;
50              
51             __END__