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   6 use strict;
  1         2  
  1         27  
4 1     1   5 use warnings;
  1         1  
  1         22  
5 1     1   4 use Carp;
  1         2  
  1         56  
6             ## no critic (ValuesAndExpressions::ProhibitConstantPragma)
7 1     1   5 use constant DEBUG => $ENV{MAKE_DEBUG};
  1         2  
  1         408  
8             ## use critic
9              
10             our $VERSION = '2.009';
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   69 my ( $class, $rule, $target ) = @_;
23 23         116 return bless [ $rule, $target ], $class;
24             }
25              
26             sub FIRSTKEY {
27 1     1   15 return $KEYS[0];
28             }
29              
30             sub NEXTKEY {
31 5     5   15 my ( $self, $lastkey ) = @_;
32 5         40 return $KEYS[ $NEXTKEY{$lastkey} ];
33             }
34              
35             sub EXISTS {
36 1     1   19 my ( $self, $key ) = @_;
37 1         7 return exists $NEXTKEY{$key};
38             }
39              
40             sub FETCH {
41 34     34   81 my ( $self, $v ) = @_;
42 34         76 my ( $rule, $target ) = @$self;
43 34         43 DEBUG and print STDERR "FETCH $v for ", $target->Name, "\n";
44 34 100       89 return $target->Name if $v eq '@';
45 27 50       55 return $target->Base if $v eq '*';
46 27 100       44 return join ' ', @{ $rule->prereqs } if $v eq '^';
  1         3  
47 26 50       55 return join ' ', $rule->out_of_date($target) if $v eq '?';
48 26 100       65 return ( @{ $rule->prereqs } )[0] if $v eq '<';
  7         23  
49 19         104 return;
50             }
51              
52             1;