#!perl
use strict;
use warnings;

use Getopt::Long;
use Make;

my (%opt, $redundancy);
if (!GetOptions(
    ## no critic (BuiltinFunctions::RequireBlockMap)
    (map +("$_!" => \$opt{$_}), qw(D g n p)),
    (map +("$_=s" => \$opt{$_}), qw(f C)),
    (map +("$_=i" => \$opt{$_}), qw(j)),
    ## use critic
    'analyse-redundancy!' => \$redundancy,
)) {
    require Pod::Usage;
    Pod::Usage::pod2usage(1);
}

chdir $opt{C} if $opt{C};

my $info = Make->new(
    GNU      => $opt{g},
    Vars     => { MAKE => "$^X $0" },
    Jobs     => $opt{j},
);
$info->parse($opt{f});

if ( $opt{D} ) {
    require Data::Dumper;
    print Data::Dumper::DumperX($info);
}
elsif ( $opt{p} ) {
    $info->Print(@ARGV);
}
elsif ( $opt{n} ) {
    print $info->Script(@ARGV);
}
elsif ( $redundancy ) {
    my $g = $info->as_graph(no_rules => 1);
    my $tcg = $g->transitive_closure(path_count => 1);
    ## no critic (BuiltinFunctions::RequireBlockGrep BuiltinFunctions::RequireBlockMap)
    my @r = grep $tcg->path_length(@$_) > 1, $g->edges;
    if (!@r) {
        print "No redundant rules found\n";
        exit 0;
    }
    @r = sort { $a->[0] cmp $b->[0] or $a->[1] cmp $b->[1] } @r;
    my %seen = map +("@$_" => 1), @r;
    for my $e (@r) {
        my $es = "@$e";
        print "Redundant: $es\n";
        print "\t$_\n"
            for sort grep !$seen{$_}++, map "@$_", all_paths($g, $tcg, @$e);
    }
    ## use critic
}
else {
    $info->Make(@ARGV);
}

sub all_paths {
    my ($g, $tcg, $u, $v) = @_;
    return if $u eq $v;
    my @found;
    push @found, [$u, $v] if $g->has_edge($u, $v);
    ## no critic (BuiltinFunctions::RequireBlockGrep BuiltinFunctions::RequireBlockMap)
    push @found,
        map [$u, @$_],
        map all_paths($g, $tcg, $_, $v),
        grep $tcg->is_reachable($_, $v),
        grep $_ ne $v, $g->successors($u);
    ## use critic
    return @found;
}

=head1 NAME

pure-perl-make - a perl 'make' replacement

=head1 SYNOPSIS

  pure-perl-make [-D] [-n] [-p] [-g] [-f Makefile] [-C directory]
    [--analyse-redundancy]
    [targets] [vars]

=head1 DESCRIPTION

Performs the same function as make(1) but is written entirely in perl.
A subset of GNU make extensions is supported.
For details see L<Make> for the underlying perl module.

=head1 FLAGS

=head2 -D

Don't build, just L<Data::Dumper/DumperX> the L<Make> object.

=head2 -n

Don't build, just print what building would have done.

=head2 -p

Don't build, just print the expanded makefile.

=head2 -g

Turn on L<Make/GNU>.

=head2 --analyse-redundancy

See if there are direct dependencies that are redundant with indirect
dependencies. E.g.:

    all: L1 L2 # no need to specify L2
    L1: L2

=head1 BUGS

=over

=item *

No B<-k> flag

=back

=head1 SEE ALSO

L<Make>, make(1), L<Graph>

=head1 AUTHOR

Nick Ing-Simmons

=cut
