File Coverage

blib/lib/Make/Rule/Vars.pm
Criterion Covered Total %
statement 30 30 100.0
branch 8 10 80.0
condition n/a
subroutine 9 9 100.0
pod n/a
total 47 49 95.9


line stmt bran cond sub pod time code
1             package Make::Rule::Vars;
2              
3 1     1   7 use strict;
  1         2  
  1         28  
4 1     1   4 use warnings;
  1         3  
  1         21  
5 1     1   5 use Carp;
  1         1  
  1         72  
6             ## no critic (ValuesAndExpressions::ProhibitConstantPragma)
7 1     1   8 use constant DEBUG => $ENV{MAKE_DEBUG};
  1         1  
  1         390  
8             ## use critic
9              
10             our $VERSION = '2.011';
11             my @KEYS = qw( @ * ^ ? < );
12             my $i;
13             ## no critic (BuiltinFunctions::RequireBlockMap)
14             my %NEXTKEY = map +( $_ => ++$i ), @KEYS;
15             ## use critic
16              
17             # Package to handle automatic variables pertaining to rules e.g. $@ $* $^ $?
18             # by using tie to this package 'subsvars' can work with array of
19             # hash references to possible sources of variable definitions.
20              
21             sub TIEHASH {
22 23     23   61 my ( $class, $rule, $target ) = @_;
23 23         102 return bless [ $rule, $target ], $class;
24             }
25              
26             sub FIRSTKEY {
27 1     1   24 return $KEYS[0];
28             }
29              
30             sub NEXTKEY {
31 5     5   11 my ( $self, $lastkey ) = @_;
32 5         32 return $KEYS[ $NEXTKEY{$lastkey} ];
33             }
34              
35             sub EXISTS {
36 1     1   25 my ( $self, $key ) = @_;
37 1         12 return exists $NEXTKEY{$key};
38             }
39              
40             sub FETCH {
41 34     34   95 my ( $self, $v ) = @_;
42 34         63 my ( $rule, $target ) = @$self;
43 34         46 DEBUG and print STDERR "FETCH $v for ", $target->Name, "\n";
44 34 100       88 return $target->Name if $v eq '@';
45 27 50       86 return $target->Base if $v eq '*';
46 27 100       53 return join ' ', @{ $rule->prereqs } if $v eq '^';
  1         3  
47 26 50       56 return join ' ', $rule->out_of_date($target) if $v eq '?';
48 26 100       53 return ( @{ $rule->prereqs } )[0] if $v eq '<';
  7         18  
49 19         79 return;
50             }
51              
52             1;