unit-tests/bin/make-recursive.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use Data::Dumper;
   5 use File::Find;
   6 use Cwd qw(realpath);
   7
   8 my @args = @ARGV;
   9
  10 my $makefiles =
  11 {
  12     'makefile' => undef,
  13     'Makefile' => undef,
  14 };
  15
  16 my $find_opts =
  17 {
  18     'wanted' => \&find_callback,
  19 };
  20
  21 my $keywords =
  22 {
  23     'root'   => '',
  24     'cwd'    => '',
  25     'cmd'    => '',
  26     'exit'   => '',
  27     'stdout' => [],
  28     'stderr' => [],
  29 };
  30
  31 my $keyword;
  32 my $max_keyword_len = 0;
  33 foreach $keyword (keys %$keywords)
  34 { if($max_keyword_len < length($keyword)) { $max_keyword_len = length($keyword); } }
  35 my $delim = ':';
  36 $max_keyword_len += length($delim) + length(' ');
  37
  38 my $last_keyword = '';
  39
  40 sub print_line
  41 {
  42     my ($keyword, $val) = @_;
  43
  44     if(!exists($$keywords{$keyword}))
  45     {
  46         print STDERR "error: keyword $keyword not in \$keywords set\n";
  47         exit(1);
  48     }
  49
  50     my $keyword_len = 0;
  51
  52     if($keyword ne $last_keyword)
  53     {
  54         print("$keyword"); print($delim);
  55         $keyword_len = length($keyword) + length($delim);
  56     }
  57     if($max_keyword_len > $keyword_len)
  58     {
  59         my $num_spaces = $max_keyword_len - $keyword_len;
  60         print(' ' x $num_spaces);
  61     }
  62     print("$val");
  63     if(0)
  64     {
  65         $last_keyword = $keyword;
  66     }
  67 }
  68
  69 my $root = '.';
  70 $root = &realpath($root);
  71 print_line("root", "$root\n");
  72
  73 find($find_opts, $root);
  74
  75 sub find_callback
  76 {
  77     if(exists($$makefiles{$_}))
  78     {
  79         my $makefile = $_;
  80         my $reldir = $File::Find::dir;
  81         $reldir =~ s|^$root/||;
  82
  83         &print_line("cwd", "\$root/$reldir\n");
  84         my $cmd = [ "make" ];
  85
  86         my $arg; foreach $arg (@ARGV) { push @$cmd, $arg; } # better way to do this?
  87         &print_line("cmd", "@$cmd\n");
  88
  89         open(SAVEOUT, ">&STDOUT") || die("$!");
  90         open(SAVEERR, ">&STDERR") || die("$!");
  91         open(STDOUT, ">/tmp/unit-tests-stdout") || die("$!");
  92         open(STDERR, ">/tmp/unit-tests-stderr") || die("$!");
  93
  94         my $exit = system(@$cmd);
  95
  96         close(STDOUT) || die("$!");
  97         close(STDERR) || die("$!");
  98         open(STDOUT, ">&SAVEOUT") || die("$!");
  99         open(STDERR, ">&SAVEERR") || die("$!");
 100
 101         &print_line("exit", "$exit\n");
 102
 103         open(OUT, "</tmp/unit-tests-stdout") || die("$!");
 104         while(<OUT>)
 105         {
 106             &print_line("stdout", "$_");
 107         }
 108         close(OUT) || die("$!");
 109         unlink("/tmp/unit-tests-stdout");
 110
 111         open(ERR, "</tmp/unit-tests-stderr") || die("$!");
 112         while(<ERR>)
 113         {
 114             &print_line("stderr", "$_");
 115         }
 116         close(ERR) || die("$!");
 117     }
 118         unlink("/tmp/unit-tests-stderr");
 119 }