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 1     1   285402 use 5.014;
  1         12  
5 1     1   5 use exact;
  1         2  
  1         12  
6 1     1   1268 use FindBin;
  1         1095  
  1         127  
7              
8             our $VERSION = '1.05'; # VERSION
9              
10             sub import {
11 1     1   24 my ( $self, $params, $caller ) = @_;
12 1   33     4 $caller //= caller();
13              
14             {
15 1     1   10 no strict 'refs';
  1         2  
  1         479  
  1         2  
16 1 50       1 *{ $caller . '::me' } = \&me unless ( defined &{ $caller . '::me' } );
  1         6  
  1         8  
17             }
18             }
19              
20             sub me {
21 3     3 1 6627 my ($path) = @_;
22              
23 3 100       13 unless ($path) {
    100          
24 1         3 return $FindBin::Bin;
25             }
26 0         0 elsif ( index( $path, '.', 0 ) == 0 ) {
27 1         6 return $FindBin::Bin . '/' . $path;
28             }
29             else {
30 1         6 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         17 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       10980 return $dir if ( -d $dir );
43 6         35 pop @search_path;
44             }
45              
46 1         10 return;
47             }
48              
49             1;
50              
51             __END__