run_branches

   1 #!/usr/bin/perl
   2
   3 =comment
   4
   5 Copyright (c) 2003-2010, Andrew Dunstan
   6
   7 See accompanying License file for license details
   8
   9 =cut
  10
  11 use vars qw($VERSION); $VERSION = 'REL_0.1';
  12
  13 use strict;
  14 use warnings;
  15 use Fcntl qw(:flock :seek);
  16 use EximBuild::Options;
  17 use File::Basename;
  18
  19 if ($0 =~ /(.*)\.pl$/) {
  20     die "$0: Please use `@{[join ' ' => $1, @ARGV]}' instead.\n"
  21         if -t;
  22     exec $1, @ARGV;
  23 }
  24
  25 my %branch_last;
  26 sub branch_last_sort;
  27
  28 my $run_build;
  29 ($run_build = $0) =~ s/run_branches/run_build/;
  30
  31 my($run_all, $run_one);
  32 my %extra_options =(
  33     'run-all' => \$run_all,
  34     'run-one' => \$run_one,
  35 );
  36
  37 # process the command line
  38 EximBuild::Options::fetch_options(%extra_options);
  39
  40 # no non-option args allowed here
  41 die("$0: non-option arguments not permitted")
  42   if @ARGV;
  43
  44 die "only one of --run-all and --run-one permitted"
  45   if ($run_all && $run_one);
  46
  47 die "need one of --run-all and --run-one"
  48   unless ($run_all || $run_one);
  49
  50 # common mistake
  51 die "need group searchable homedir"
  52   unless (stat($ENV{HOME}) & 0550 == 0550);
  53
  54 # set up a "branch" variable for processing the config file
  55 use vars qw($branch);
  56 $branch = 'global';
  57
  58 #
  59 # process config file
  60 #
  61 require $buildconf;
  62
  63 unless (
  64     (
  65         ref $EximBuild::conf{branches_to_build} eq 'ARRAY'
  66         &&@{$EximBuild::conf{branches_to_build}}
  67     )
  68     ||$EximBuild::conf{branches_to_build} =~
  69     /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/
  70   )
  71 {
  72     die "no branches_to_build specified in $buildconf";
  73 }
  74
  75 my @branches;
  76 if (ref $EximBuild::conf{branches_to_build})
  77 {
  78     @branches = @{$EximBuild::conf{branches_to_build}};
  79 }
  80 elsif ($EximBuild::conf{branches_to_build} =~
  81     /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/ )
  82 {
  83
  84     # Need to set the path here so we make sure we pick up the right perl.
  85     # It has to be the perl that the build script would choose
  86     # i.e. specially *not* the MinGW SDK perl that is invoked for the
  87     # build script, which means we need to put the path back the way it was
  88     # when we're done
  89     my $save_path = $ENV{PATH};
  90     $ENV{PATH} = $EximBuild::conf{build_env}->{PATH}
  91       if ($EximBuild::conf{build_env}->{PATH});
  92     (my $url = $EximBuild::conf{target}) =~s/cgi-bin.*/branches_of_interest.txt/;
  93     my $branches_of_interest = `perl -MLWP::Simple -e "getprint(q{$url})"`;
  94     die "getting branches of interest" unless $branches_of_interest;
  95     $ENV{PATH} = $save_path;
  96     push(@branches,$_)foreach (split(/\s+/,$branches_of_interest));
  97     #splice(@branches,0,-2)
  98     #  if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST';
  99     #splice(@branches,0,-3)
 100     #  if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST2';
 101 }
 102
 103 @branches = apply_throttle(@branches);
 104
 105 my $global_lock_dir =
 106     $EximBuild::conf{global_lock_dir}
 107   ||$EximBuild::conf{build_root}
 108   ||'';
 109
 110 unless ($global_lock_dir && -d $global_lock_dir)
 111 {
 112     die "no global lock directory: $global_lock_dir";
 113 }
 114
 115 # acquire the lock
 116
 117 my $lockfile;
 118
 119 my $lockfilename = "$global_lock_dir/GLOBAL.lck";
 120
 121 open($lockfile, ">$lockfilename") || die "opening lockfile: $!";
 122
 123 if ( !flock($lockfile,LOCK_EX|LOCK_NB) )
 124 {
 125     print "Another process holds the lock on " ."$lockfilename. Exiting.\n"
 126       if ($verbose);
 127     exit(0);
 128 }
 129
 130 if ($run_all)
 131 {
 132     foreach my $brnch(@branches)
 133     {
 134         run_branch($brnch);
 135     }
 136 }
 137 elsif ($run_one)
 138 {
 139
 140     # sort the branches by the order in which they last did actual work
 141     # then try running them in that order until one does some work
 142
 143     %branch_last = map {$_ => find_last_status($_)} @branches;
 144     foreach my $brnch(sort branch_last_sort @branches)
 145     {
 146         run_branch($brnch);
 147         my $new_status = find_last_status($brnch);
 148         last if $new_status != $branch_last{$brnch};
 149     }
 150 }
 151
 152 exit 0;
 153
 154 ##########################################################
 155
 156 sub run_branch
 157 {
 158     my $branch = shift;
 159     my @args = ($run_build,EximBuild::Options::standard_option_list(), $branch);
 160
 161     # Explicitly use perl from the path (and not this perl, so don't use $^X)
 162     # This script needs to run on Cygwin with non-cygwin perl if it's running
 163     # in tandem with AS/MinGW perl, since Cygwin perl doesn't honor locks
 164     # the samne way, and the global lock fails. But the build script needs
 165     # to run with the native perl, even on Cygwin, which it picks up from
 166     # the path. (Head exploding yet?).
 167     system("perl",@args);
 168 }
 169
 170 sub branch_last_sort
 171 {
 172     return $branch_last{$a} <=> $branch_last{$b};
 173 }
 174
 175 sub find_last_status
 176 {
 177     my $brnch = shift;
 178     my $status_file =
 179       "$EximBuild::conf{build_root}/$brnch/$EximBuild::conf{animal}.last.status";
 180     return 0 unless (-e  $status_file);
 181     my $handle;
 182     open($handle,$status_file) || dir $!;
 183     my $ts = <$handle>;
 184     chomp $ts;
 185     close($handle);
 186     return $ts + 0;
 187 }
 188
 189 sub apply_throttle
 190 {
 191     my @branches = @_;
 192     return @branches unless exists $EximBuild::conf{throttle};
 193     my @result;
 194     my %throttle = %{$EximBuild::conf{throttle}};
 195
 196     # implement throttle keywords ALL !HEAD and !RECENT
 197     my @candidates;
 198     my $replacement;
 199     if (exists $throttle{ALL})
 200     {
 201         @candidates = @branches;
 202         $replacement = $throttle{ALL};
 203     }
 204     elsif (exists  $throttle{'!HEAD'})
 205     {
 206         @candidates = grep { $_ ne 'HEAD' } @branches;
 207         $replacement = $throttle{'!HEAD'};
 208     }
 209     elsif (exists  $throttle{'!RECENT'})
 210     {
 211
 212         # sort branches, make sure we get numeric major version sorting right
 213         my @stable = grep { $_ ne 'HEAD' } @branches;
 214         s/^REL(\d)_/0$1/ foreach (@stable);
 215         @stable = sort @stable;
 216         s/^REL0/REL/ foreach (@stable);
 217         pop @stable; # remove latest
 218         @candidates = @stable;
 219         $replacement = $throttle{'!RECENT'};
 220     }
 221     foreach my $cand (@candidates)
 222     {
 223
 224         # only supply this for the branch if there isn't already
 225         # a throttle
 226         $throttle{$cand} ||= $replacement;
 227     }
 228
 229     # apply throttle filters
 230     foreach my $branch(@branches)
 231     {
 232         my $this_throttle =  $throttle{$branch};
 233         unless (defined $this_throttle)
 234         {
 235             push(@result,$branch);
 236             next;
 237         }
 238         my $minh = $this_throttle->{min_hours_since};
 239         my $ts = find_last_status($branch);
 240         next
 241           if ( $ts
 242             && (defined $minh)
 243             &&($minh && $minh < ((time - $ts) / 3600.0)));
 244         if (exists $this_throttle->{allowed_hours})
 245         {
 246             my @allowed_hours = split(/,/,$this_throttle->{allowed_hours});
 247             my $hour = (localtime(time))[2];
 248             next unless grep {$_ == $hour} @allowed_hours;
 249         }
 250         push(@result,$branch);
 251     }
 252
 253     return @result;
 254 }