File Coverage

blib/lib/TinyMake.pm

Criterion	Covered	Total	%
statement	6	103	5.8
branch	0	38	0.0
condition	0	6	0.0
subroutine	2	13	15.3
pod	5	9	55.5
total	13	169	7.6

package TinyMake;
our $VERSION = '0.06';

=head1 NAME

TinyMake - A minimalist build language, similar in purpose to make and ant.

=head1 SYNOPSIS

   use TinyMake ':all';

   # a file statement without a rule is like a symbolic target
   file all => ["codeGen", "compile", "dataLoad", "test"];

   file codeGen => ["database.spec"], sub {
     # generate code here
     sh "touch $target";
   } ;

   file compile => ["codeGen"], sub {
     # compile code here
     sh "touch $target";
   } ;

   file dataLoad => ["codeGen"], sub {
     # load data here
     sh "touch $target"
   } ;

   file test => ["compile", "dataLoad"], sub {
     # test code here
     sh "touch $target";
   } ;
   # a file statement without prerequisites will be executed
   # if the target doesn't exist.
   file clean => sub {
     # perform cleanup here
     sh "rm compile codeGen dataLoad test"
   } ;

   make @ARGV

=cut

use strict;
use File::Find ;

require Exporter;
our @ISA = ("Exporter");
our @EXPORT_OK = qw(file make show group $target @changed @sources sh filetree);
our %EXPORT_TAGS = (all => \@EXPORT_OK,);
#---------------------------------------------------------------------------
#
# Exported variables (for use in rules)
#
#===========================================================================
our @changed = ();
our @sources = ();
our $target = undef;

#---------------------------------------------------------------------------
#
# Private variables
#
#===========================================================================

# prerequisites grouped by target (target => [prerequisites])
#
my %prerequisites_for_target = ();


# (target => $coderef)
#
my %command_for_target = ();


# (target => "A descriptive comment for how target gets built")
#
my %comment_for_target = ();


# The default target is always the first target declared using either
# file or group
#
my $first = undef;

#---------------------------------------------------------------------------
#
# walk a tree in post-order return a list of walked nodes
#
#===========================================================================
sub postorderwalk {

  my ($node,$children,$store,$visited) = @_;

  return if (grep { $_ eq $node} @$visited);

  push @$visited, $node;

  my @kids = $children->($node);

  foreach (@kids){

    postorderwalk($_,$children,$store,$visited) ;

  }

  push @$store, $node;
  @$store;
}
#---------------------------------------------------------------------------
#
# traverse the dependency tree post-orderly and return the list of targets
#
#===========================================================================
sub depends {

  my ($t,$store,$visited) = @_;

  my $children = sub {

    my ($node) = @_;

    if (exists $prerequisites_for_target{$node}) {

      return @{$prerequisites_for_target{$node}} ;

    }
    return ();

  };

  postorderwalk ($t, $children, $store,$visited);
}
#---------------------------------------------------------------------------
#
# Show Dependency tree: Prints out a nested list of target and dependencies
#
#===========================================================================
sub show (@_){

  my ($node,$lvl) = @_;

  if (!(defined $node)){
    $node = $first;
  }

  if (!(defined $lvl)){
    $lvl = 0;
  }

  if (exists $command_for_target{$node}){
    print "   " x $lvl . "*$node";

  }else{
    print "   " x $lvl . "$node";

  }

  if (exists $comment_for_target{$node}){
    print " - $comment_for_target{$node}";
  }

  print "\n";

  $lvl+=1; # increase indentation

  if (exists $prerequisites_for_target{$node}){

    my @children = @{$prerequisites_for_target{$node}};

    foreach (@children){
      show ($_, $lvl);
    }

  }
  $lvl-=1;
}
#---------------------------------------------------------------------------
#
# Execute shell command: prints the shell command, the executes it
#
#===========================================================================
sub sh (@){

  print "@_\n";

  return qx(@_);

}
#---------------------------------------------------------------------------
#
# Add a new explicit target :
#
#===========================================================================
sub file {

  my ($t,@params) = @_;
  $first = $t unless defined $first;

  if (@params){

    foreach (0..$#params){

      if (ref $params[$_] eq "CODE"){
        $command_for_target{$t} = $params[$_];
        next;
      }

      if (ref $params[$_] eq "ARRAY"){
        $prerequisites_for_target{$t} = $params[$_];
        next;
      }

      if (ref $params[$_] eq "" and $params[$_] ne ""){
        $comment_for_target{$t} = $params[$_];
        next;
      }

    }

  }else{

    # TinyMake cannot read minds yet.
    $prerequisites_for_target{$t} = [];

  }

}
#---------------------------------------------------------------------------
#
# Add a new group of explicit targets
#
#===========================================================================
sub group {

  my ($t,$href,$coderef,@rest) = @_;

  foreach (keys %$href) {

    file $_ => $href->{$_}, $coderef, @rest;

  }

  file $t => [keys %$href];

}
#---------------------------------------------------------------------------
#
# Return the lastmodified time for each source file
#
#===========================================================================
{
  my %cachedsourcetimes = ();

  sub sourcetimes {
    #  map {$_ => -M $_} @_;
    my %result = ();

    foreach my $source (@_){

      my $value = undef;
      #
      # if the source is not itself a target then
      # cache its modification time. THis assumes
      # that such sources will not be modified as a side effect
      # of any production rule during execution!!!!
      #
      if (exists $command_for_target{$source} or
          exists $prerequisites_for_target{$source} ){

        # the source file is also mentioned as a target
        #
        my @filestats = stat $source;
        $value = $filestats[9];

      }else{

        # the sourcefile is not mentioned as a target
        # (it is pure)
        #
        if (!exists $cachedsourcetimes{$source}){

          my @filestats = stat $source;
          $cachedsourcetimes{$source} = $filestats[9];

        }
        $value = $cachedsourcetimes{$source};

      }
      $result{$source} = $value;

    }
    %result;

  }

}
#---------------------------------------------------------------------------
#
# build the production script.
#
#===========================================================================
sub make {

  my @result = ();
  @_ = ($first) unless (@_);
  my $exec = 0;

  foreach (@_){

    my @files = depends $_,[],[];
    my @files_i_can_build = grep {exists $command_for_target{$_} } @files;

    foreach (@files_i_can_build){

      $target = $_;
      @changed = @sources = ();

      if (exists $prerequisites_for_target{$target}){

        @sources = @{$prerequisites_for_target{$target}} ;
        @changed = @sources;

      }

      $exec = 1;

      if (-e $target){

        my @filestats = stat $target;
        my $targettime = $filestats[9];
        my %sourcetimes = sourcetimes @sources;
        $exec = @changed = grep { $sourcetimes{$_} > $targettime } @sources;

      }

      if ($exec){

        $command_for_target{$target}->() ;
        push @result, $target;

      }

    }
    print "'$_' is up to date\n" unless ($exec);
  }
  @result;
}

#---------------------------------------------------------------------------
#
# Get a recursive listing of files in a given directory
#
#===========================================================================
sub filetree {

  my @found = ();
  File::Find::find sub{  push @found, $File::Find::name }, @_;
  return @found;

}

1;

__END__