X-Git-Url: https://git.exim.org/buildfarm-client.git/blobdiff_plain/ea0a7aa537a6f344e1e694f13c0921c78438f566..66c62beda0bfbb2fd194cbd3590e9fa51eb7220e:/run_branches.pl diff --git a/run_branches.pl b/run_branches.pl deleted file mode 100755 index 702d1a4..0000000 --- a/run_branches.pl +++ /dev/null @@ -1,244 +0,0 @@ -#!/usr/bin/perl - -=comment - -Copyright (c) 2003-2010, Andrew Dunstan - -See accompanying License file for license details - -=cut - -use vars qw($VERSION); $VERSION = 'REL_0.1'; - -use strict; -use warnings; -use Fcntl qw(:flock :seek); -use EximBuild::Options; -use File::Basename; - -my %branch_last; -sub branch_last_sort; - -my $run_build; -($run_build = $0) =~ s/run_branches/run_build/; - -my($run_all, $run_one); -my %extra_options =( - 'run-all' => \$run_all, - 'run-one' => \$run_one, -); - -# process the command line -EximBuild::Options::fetch_options(%extra_options); - -# no non-option args allowed here -die("$0: non-option arguments not permitted") - if @ARGV; - -die "only one of --run-all and --run-one permitted" - if ($run_all && $run_one); - -die "need one of --run-all and --run-one" - unless ($run_all || $run_one); - -# set up a "branch" variable for processing the config file -use vars qw($branch); -$branch = 'global'; - -# -# process config file -# -require $buildconf; - -unless ( - ( - ref $EximBuild::conf{branches_to_build} eq 'ARRAY' - &&@{$EximBuild::conf{branches_to_build}} - ) - ||$EximBuild::conf{branches_to_build} =~ - /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/ - ) -{ - die "no branches_to_build specified in $buildconf"; -} - -my @branches; -if (ref $EximBuild::conf{branches_to_build}) -{ - @branches = @{$EximBuild::conf{branches_to_build}}; -} -elsif ($EximBuild::conf{branches_to_build} =~ - /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/ ) -{ - - # Need to set the path here so we make sure we pick up the right perl. - # It has to be the perl that the build script would choose - # i.e. specially *not* the MinGW SDK perl that is invoked for the - # build script, which means we need to put the path back the way it was - # when we're done - my $save_path = $ENV{PATH}; - $ENV{PATH} = $EximBuild::conf{build_env}->{PATH} - if ($EximBuild::conf{build_env}->{PATH}); - (my $url = $EximBuild::conf{target}) =~s/cgi-bin.*/branches_of_interest.txt/; - my $branches_of_interest = `perl -MLWP::Simple -e "getprint(q{$url})"`; - die "getting branches of interest" unless $branches_of_interest; - $ENV{PATH} = $save_path; - push(@branches,$_)foreach (split(/\s+/,$branches_of_interest)); - #splice(@branches,0,-2) - # if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST'; - #splice(@branches,0,-3) - # if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST2'; -} - -@branches = apply_throttle(@branches); - -my $global_lock_dir = - $EximBuild::conf{global_lock_dir} - ||$EximBuild::conf{build_root} - ||''; - -unless ($global_lock_dir && -d $global_lock_dir) -{ - die "no global lock directory: $global_lock_dir"; -} - -# acquire the lock - -my $lockfile; - -my $lockfilename = "$global_lock_dir/GLOBAL.lck"; - -open($lockfile, ">$lockfilename") || die "opening lockfile: $!"; - -if ( !flock($lockfile,LOCK_EX|LOCK_NB) ) -{ - print "Another process holds the lock on " ."$lockfilename. Exiting.\n" - if ($verbose); - exit(0); -} - -if ($run_all) -{ - foreach my $brnch(@branches) - { - run_branch($brnch); - } -} -elsif ($run_one) -{ - - # sort the branches by the order in which they last did actual work - # then try running them in that order until one does some work - - %branch_last = map {$_ => find_last_status($_)} @branches; - foreach my $brnch(sort branch_last_sort @branches) - { - run_branch($brnch); - my $new_status = find_last_status($brnch); - last if $new_status != $branch_last{$brnch}; - } -} - -exit 0; - -########################################################## - -sub run_branch -{ - my $branch = shift; - my @args = ($run_build,EximBuild::Options::standard_option_list(), $branch); - - # Explicitly use perl from the path (and not this perl, so don't use $^X) - # This script needs to run on Cygwin with non-cygwin perl if it's running - # in tandem with AS/MinGW perl, since Cygwin perl doesn't honor locks - # the samne way, and the global lock fails. But the build script needs - # to run with the native perl, even on Cygwin, which it picks up from - # the path. (Head exploding yet?). - system("perl",@args); -} - -sub branch_last_sort -{ - return $branch_last{$a} <=> $branch_last{$b}; -} - -sub find_last_status -{ - my $brnch = shift; - my $status_file = - "$EximBuild::conf{build_root}/$brnch/$EximBuild::conf{animal}.last.status"; - return 0 unless (-e $status_file); - my $handle; - open($handle,$status_file) || dir $!; - my $ts = <$handle>; - chomp $ts; - close($handle); - return $ts + 0; -} - -sub apply_throttle -{ - my @branches = @_; - return @branches unless exists $EximBuild::conf{throttle}; - my @result; - my %throttle = %{$EximBuild::conf{throttle}}; - - # implement throttle keywords ALL !HEAD and !RECENT - my @candidates; - my $replacement; - if (exists $throttle{ALL}) - { - @candidates = @branches; - $replacement = $throttle{ALL}; - } - elsif (exists $throttle{'!HEAD'}) - { - @candidates = grep { $_ ne 'HEAD' } @branches; - $replacement = $throttle{'!HEAD'}; - } - elsif (exists $throttle{'!RECENT'}) - { - - # sort branches, make sure we get numeric major version sorting right - my @stable = grep { $_ ne 'HEAD' } @branches; - s/^REL(\d)_/0$1/ foreach (@stable); - @stable = sort @stable; - s/^REL0/REL/ foreach (@stable); - pop @stable; # remove latest - @candidates = @stable; - $replacement = $throttle{'!RECENT'}; - } - foreach my $cand (@candidates) - { - - # only supply this for the branch if there isn't already - # a throttle - $throttle{$cand} ||= $replacement; - } - - # apply throttle filters - foreach my $branch(@branches) - { - my $this_throttle = $throttle{$branch}; - unless (defined $this_throttle) - { - push(@result,$branch); - next; - } - my $minh = $this_throttle->{min_hours_since}; - my $ts = find_last_status($branch); - next - if ( $ts - && (defined $minh) - &&($minh && $minh < ((time - $ts) / 3600.0))); - if (exists $this_throttle->{allowed_hours}) - { - my @allowed_hours = split(/,/,$this_throttle->{allowed_hours}); - my $hour = (localtime(time))[2]; - next unless grep {$_ == $hour} @allowed_hours; - } - push(@result,$branch); - } - - return @result; -} diff --git a/run_branches.pl b/run_branches.pl new file mode 120000 index 0000000..022fd6b --- /dev/null +++ b/run_branches.pl @@ -0,0 +1 @@ +run_branches \ No newline at end of file