view release on metacpan or  search on metacpan

lib/Beam/Make.pm  view on Meta::CPAN

use v5.20;
use warnings;
use Log::Any qw( $LOG );
use Moo;
use experimental qw( signatures postderef );
use Time::Piece;
use YAML ();
use Beam::Wire;
use Scalar::Util qw( blessed );
use List::Util qw( max );
use Beam::Make::Cache;
use File::stat;
with 'Beam::Runnable';

has conf => ( is => 'ro', default => sub { YAML::LoadFile( 'Beamfile' ) } );
# Beam::Wire container objects
has _wire => ( is => 'ro', default => sub { {} } );

sub run( $self, @argv ) {
    my ( @targets, %vars );

    for my $arg ( @argv ) {
        if ( $arg =~ /^([^=]+)=([^=]+)$/ ) {
            $vars{ $1 } = $2;
        }
        else {
            push @targets, $arg;
        }
    }

    local @ENV{ keys %vars } = values %vars;
    my $conf = $self->conf;
    my $cache = Beam::Make::Cache->new;

    # Targets must be built in order
    # Prereqs satisfied by original target remain satisfied
    my %recipes; # Built recipes
    my @target_stack;
    # Build a target (if necessary) and return its last modified date.
    # Each dependent will be checked against their depencencies' last
    # modified date to see if they need to be updated
    my $build = sub( $target ) {
        $LOG->debug( "Want to build: $target" );
        if ( grep { $_ eq $target } @target_stack ) {
            die "Recursion at @target_stack";
        }
        # If we already have the recipe, it must already have been run
        if ( $recipes{ $target } ) {
            $LOG->debug( "Nothing to do: $target already built" );
            return $recipes{ $target }->last_modified;
        }

        # If there is no recipe for the target, it must be a source
        # file. Source files cannot be built, but we do want to know
        # when they were last modified
        if ( !$conf->{ $target } ) {
            $LOG->debug(
                "$target has no recipe and "
                . ( -e $target ? 'exists as a file' : 'does not exist as a file' )
            );
            return stat( $target )->mtime if -e $target;
            die $LOG->errorf( q{No recipe for target "%s" and file does not exist}."\n", $target );
        }

        # Resolve any references in the recipe object via Beam::Wire
        # containers.
        my $target_conf = $self->_resolve_ref( $conf->{ $target } );
        my $class = delete( $target_conf->{ '$class' } ) || 'Beam::Make::File';
        $LOG->debug( "Building recipe object $target ($class)" );
        eval "require $class";
        if ( $@ ) {
            die "Could not load $class: $@";
        }
        my $recipe = $recipes{ $target } = $class->new(
            $target_conf->%*,
            name => $target,
            cache => $cache,
        );

        my $requires_modified = 0;
        if ( my @requires = $recipe->requires->@* ) {
            $LOG->debug( "Checking requirements for $target: @requires" );
            push @target_stack, $target;
            for my $require ( @requires ) {
                $requires_modified = max $requires_modified, __SUB__->( $require );
            }
            pop @target_stack;
        }

        # Do we need to build this recipe?
        my $result;
        if ( $requires_modified > ( $recipe->last_modified || -1 ) ) {
            $LOG->debug( "Building $target" );
            $recipe->make( %vars );
            $result = $LOG->info( "$target updated (modified: " . $recipe->last_modified . ")" );
        }
        else {
            $result = $LOG->info( "$target up-to-date (modified: " . $recipe->last_modified . ")" );
        }
        if ( !@target_stack && !$LOG->is_info ) {
            # We were directly asked to build this, so let the user
            # know about it
            say $result;
        }
        return $recipe->last_modified;
    };
    $build->( $_ ) for @targets;
}

# Resolve any references via Beam::Wire container lookups
sub _resolve_ref( $self, $conf ) {
    return $conf if !ref $conf || blessed $conf;
    if ( ref $conf eq 'HASH' ) {
        if ( grep { $_ !~ /^\$/ } keys %$conf ) {
            my %resolved;
            for my $key ( keys %$conf ) {
                $resolved{ $key } = $self->_resolve_ref( $conf->{ $key } );
            }
            return \%resolved;
        }
        else {