File Coverage

blib/lib/Makefile/AST/Rule.pm
Criterion Covered Total %
statement 15 96 15.6
branch 0 32 0.0
condition 0 12 0.0
subroutine 5 10 50.0
pod 0 5 0.0
total 20 155 12.9


line stmt bran cond sub pod time code
1             package Makefile::AST::Rule;
2              
3 2     2   579 use strict;
  2         4  
  2         76  
4 2     2   11 use warnings;
  2         3  
  2         65  
5              
6             #use Smart::Comments;
7 2     2   9 use base 'Makefile::AST::Rule::Base';
  2         3  
  2         566  
8 2     2   891 use Makefile::AST::Command;
  2         4  
  2         13  
9 2     2   1174 use List::MoreUtils;
  2         1905  
  2         2039  
10              
11             __PACKAGE__->mk_accessors(qw{
12             stem target other_targets shell
13             });
14              
15             # XXX: generate description for the rule
16             sub as_str ($) {
17 0     0 0   my $self = shift;
18 0           my $order_part = '';
19             ## as_str: order_prereqs: $self->order_prereqs
20 0 0         if (@{ $self->order_prereqs }) {
  0            
21 0           $order_part = " | " . join(" ",@{ $self->order_prereqs });
  0            
22             }
23             ### colon: $self->colon
24 0           my $str = $self->target . " " .
25             $self->colon . " " .
26 0           join(" ", @{ $self->normal_prereqs }) . "$order_part ; " .
27 0           join("", map { "[$_]" } @{ $self->commands });
  0            
28 0           $str =~ s/\n+//g;
29 0           $str =~ s/ +/ /g;
30 0           $str;
31             }
32              
33             sub prepare_command ($$) {
34 0     0 0   my ($self, $ast, $raw_cmd,
35             $silent, $tolerant, $critical) = @_;
36              
37             ## $raw_cmd
38 0           my @tokens = $raw_cmd->elements;
39              
40             # try to recognize modifiers:
41 0           my $modifier;
42 0           while (@tokens) {
43 0 0         if ($tokens[0]->class eq 'MDOM::Token::Whitespace') {
44 0           shift @tokens;
45 0           next;
46             }
47 0 0         last unless $tokens[0]->class eq 'MDOM::Token::Modifier';
48 0           $modifier = shift @tokens;
49 0 0         if ($modifier eq '+') {
    0          
    0          
50             # XXX is this the right thing to do?
51 0           $critical = 1;
52             } elsif ($modifier eq '-') {
53 0           $tolerant = 1;
54             } elsif ($modifier eq '@') {
55 0           $silent = 1;
56             } else {
57 0           die "Unknown modifier: $modifier";
58             }
59             }
60 0           local $. = $raw_cmd->lineno;
61             ## TOKENS (BEFORE): @tokens
62 0           my $cmd = $ast->solve_refs_in_tokens(\@tokens);
63             ### cmd after solve (1): $cmd
64              
65 0           $cmd =~ s/^\s+|\s+$//gs;
66 0 0         return () if $cmd =~ /^(\\\n)*\\?$/s;
67             ### cmd after modifier extraction: $cmd
68             ### critical (+): $critical
69             ### tolerant (-): $tolerant
70             ### silent (@): $silent
71 0 0         if ($cmd =~ /(?
72             # it seems to be a canned sequence of commands
73             # XXX This is a hack to get things work
74 0           my @cmd = split /(?
75 0           my @ast_cmds;
76 0           for (@cmd) {
77 0           s/^\s+|\s+$//g;
78 0           require MDOM::Document::Gmake;
79 0           @tokens = MDOM::Document::Gmake::_tokenize_command($_);
80             ### Reparsed cmd tokens: @tokens
81 0           my $cmd = MDOM::Command->new;
82 0           $cmd->__add_elements(@tokens);
83             # XXX upper-level's modifiers should take in
84             # effect in the recursive calls:
85 0           push @ast_cmds, $self->prepare_command($ast, $cmd, $silent, $tolerant, $critical);
86             }
87 0           return @ast_cmds;
88             }
89 0           while (1) {
90 0 0         if ($cmd =~ s/^\s*\+//) {
    0          
    0          
91             # XXX is this the right thing to do?
92 0           $critical = 1;
93             } elsif ($cmd =~ s/^\s*-//) {
94 0           $tolerant = 1;
95             } elsif ($cmd =~ s/^\s*\@//) {
96 0           $silent = 1;
97             } else {
98 0           last;
99             }
100             }
101 0           $cmd =~ s/^\s+|\s+$//gs;
102 0 0         return () if $cmd =~ /^(\\\n)*\\?$/s;
103 0           return Makefile::AST::Command->new({
104             silent => $silent,
105             tolerant => $tolerant,
106             critical => $critical,
107             content => $cmd,
108             target => $self->target,
109             });
110             }
111              
112             sub prepare_commands ($$) {
113 0     0 0   my ($self, $ast) = @_;
114 0           my @normal_prereqs = @{ $self->normal_prereqs };
  0            
115 0           my @order_prereqs = @{ $self->order_prereqs };
  0            
116             ## @normal_prereqs
117             ## @order_prereqs
118             ### run_commands: target: $self->target
119             ### run_commands: Stem: $self->stem
120 0           $self->shell($ast->eval_var_value('SHELL'));
121 0           $ast->enter_pad;
122 0           $ast->add_auto_var(
123             '@' => [$self->target],
124             '<' => [$normal_prereqs[0]], # XXX better solutions?
125             '*' => [$self->stem],
126             '^' => [join(" ", List::MoreUtils::uniq(@normal_prereqs))],
127             '+' => [join(" ", @normal_prereqs)],
128             '|' => [join(" ", List::MoreUtils::uniq(@order_prereqs))],
129             # XXX add more automatic vars' defs here
130             );
131             ### auto $*: $ast->get_var('*')
132 0           my @ast_cmds;
133 0           for my $cmd (@{ $self->commands }) {
  0            
134 0           $Makefile::AST::Evaluator::CmdRun = 1;
135 0           push @ast_cmds, $self->prepare_command($ast, $cmd);
136             }
137 0           $ast->leave_pad;
138 0           return @ast_cmds;
139             }
140              
141             sub run_command ($$) {
142 0     0 0   my ($self, $ast_cmd) = @_;
143 0           my $cmd = $ast_cmd->content;
144 0 0 0       if (!$Makefile::AST::Evaluator::Quiet &&
      0        
145             (!$ast_cmd->silent || $Makefile::AST::Evaluator::JustPrint)) {
146 0           print "$cmd\n";
147             }
148 0 0         if (! $Makefile::AST::Evaluator::JustPrint) {
149 0           system($self->shell, '-c', $cmd);
150 0 0         if ($? != 0) {
151 0           my $retval = $? >> 8;
152 0           my $target = $ast_cmd->target;
153 0 0 0       if (!$Makefile::AST::Evaluator::IgnoreErrors &&
      0        
154             (!$ast_cmd->tolerant || $ast_cmd->critical)) {
155             # XXX better handling for tolerance
156 0           die "$::MAKE: *** [$target] Error $retval\n";
157             } else {
158 0           warn "$::MAKE: [$target] Error $retval (ignored)\n";
159             }
160             }
161             }
162             }
163              
164             sub run_commands ($@) {
165 0     0 0   my $self = shift;
166 0           for my $ast_cmd (@_) {
167 0           $self->run_command($ast_cmd);
168             }
169             }
170              
171             1;