view release on metacpan or  search on metacpan

lib/Makefile/AST/Evaluator.pm  view on Meta::CPAN

package Makefile::AST::Evaluator;

use strict;
use warnings;

our $VERSION = '0.216';

#use Smart::Comments;
#use Smart::Comments '####';
use File::stat;
use Class::Trigger qw(firing_rule);

# XXX put these globals to some better place
our (
    $Quiet, $JustPrint, $IgnoreErrors,
    $AlwaysMake, $Question
);

sub new ($$) {
    my $class = ref $_[0] ? ref shift : shift;
    my $ast = shift;
    return bless {
        ast     => $ast,
        updated => {},
        mtime_cache => {},  # this is better for the AST?
        parent_target => undef,
        targets_making => {},
        required_targets => {},
    }, $class;
}

sub ast ($) { $_[0]->{ast} }

sub mark_as_updated ($$) {
    my ($self, $target) = @_;
    ### marking target as updated: $target
    $self->{updated}->{$target} = 1;
}

# XXX this should be moved to the AST
sub is_updated ($$) {
    my ($self, $target) = @_;
    $self->{updated}->{$target};
}

# update the mtime cache with -M $file
sub update_mtime ($$@) {
    my ($self, $file, $cache) = @_;
    $cache ||= $self->{mtime_cache};
    if (-e $file) {
        my $stat = stat $file or
            die "$::MAKE: *** stat failed on $file: $!\n";
        ### set mtime for file: $file
        ### mtime: $stat->mtime
        return ($cache->{$file} = $stat->mtime);
    } else {
        ## file not found: $file
        return ($cache->{$file} = undef);
    }
}

# get -M $file from cache (if any) or set the cache
#  key-value pair otherwise
sub get_mtime ($$) {
    my ($self, $file) = @_;
    my $cache = $self->{mtime_cache};
    if (!exists $cache->{$file}) {
        # set the cache
        return $self->update_mtime($file, $cache);
    }
    return $cache->{$file};
}

sub set_required_target ($$) {
    my ($self, $target) = @_;
    $self->{required_targets}->{$target} = 1;
}

sub is_required_target ($$) {
    my ($self, $target) = @_;
    $self->{required_targets}->{$target};
}

sub make ($$) {
    my ($self, $target) = @_;
    return 'UP_TO_DATE'
        if $self->is_updated($target);
    my $making = $self->{targets_making};
    if ($making->{$target}) {
        warn "$::MAKE: Circular $target <- $target ".
            "dependency dropped.\n";
        return 'UP_TO_DATE';
    } else {
        $making->{$target} = 1;
    }
    my $retval;
    my @rules = $self->ast->apply_explicit_rules($target);
    ### number of explicit rules: scalar(@rules)
    if (@rules == 0) {
        ### no rule matched the target: $target
        ### trying to make implicitly here...
        my $ret = $self->make_implicitly($target);
        delete $making->{$target};
        if (!$ret) {
            return $self->make_by_rule($target => undef);
        } else {
            return $ret;