EximBuild/SCM.pm

   1 use strict;
   2
   3 use File::Find;
   4 use Cwd;
   5
   6 =comment
   7
   8 Copyright (c) 2003-2010, Andrew Dunstan
   9
  10 See accompanying License file for license details
  11
  12 =cut
  13
  14 ##########################################################################
  15 #
  16 # SCM Class and subclasses for specific SCMs (currently CVS and git).
  17 #
  18 #########################################################################
  19
  20 package EximBuild::SCM;
  21
  22 use vars qw($VERSION); $VERSION = 'REL_0.1';
  23
  24 # factory function to return the right subclass
  25 sub new
  26 {
  27     my $class = shift;
  28     my $conf = shift;
  29     my $target = shift || 'exim';
  30     if (defined($conf->{scm}) &&  $conf->{scm} =~ /^git$/i)
  31     {
  32         $conf->{scm} = 'git';
  33         return new EximBuild::SCM::Git $conf, $target;
  34     }
  35     #elsif ((defined($conf->{scm}) &&  $conf->{scm} =~ /^cvs$/i )
  36     #    ||$conf->{csvrepo}
  37     #    ||$conf->{cvsmethod})
  38     #{
  39     #    $conf->{scm} = 'cvs';
  40     #    return new EximBuild::SCM::CVS $conf, $target;
  41     #}
  42     die "only Git currently supported";
  43 }
  44
  45 # common routine use for copying the source, called by the
  46 # SCM objects (directly, not as class methods)
  47 sub copy_source
  48 {
  49     my $using_msvc = shift;
  50     my $target = shift;
  51     my $build_path = shift;
  52
  53     # annoyingly, there isn't a standard perl module to do a recursive copy
  54     # and I don't want to require use of the non-standard File::Copy::Recursive
  55     system("cp -r $target $build_path 2>&1");
  56     my $status = $? >> 8;
  57     die "copying directories: $status" if $status;
  58
  59 }
  60
  61 # required operations in each subclass:
  62 # new()
  63 # copy_source_required()
  64 # copy_source()
  65 # check_access()
  66 # get_build_path()
  67 # checkout()
  68 # cleanup()
  69 # find_changed()
  70 # get_versions()
  71 # log_id()
  72
  73 ##################################
  74 #
  75 # SCM for git
  76 #
  77 ##################################
  78
  79 package EximBuild::SCM::Git;
  80
  81 use File::Copy;
  82 use Cwd;
  83
  84 sub new
  85 {
  86     my $class = shift;
  87     my $conf = shift;
  88     my $target = shift;
  89     my $self = {};
  90     $self->{gitrepo} = $conf->{scmrepo} ||
  91                        "git://git.exim.org/exim.git";
  92     $self->{reference} = $conf->{git_reference}
  93       if defined($conf->{git_reference});
  94     $self->{mirror} =(
  95         $target eq 'exim'
  96         ? "$conf->{build_root}/exim.git"
  97         :"$conf->{build_root}/$target-exim.git"
  98     )if $conf->{git_keep_mirror};
  99     $self->{ignore_mirror_failure} = $conf->{git_ignore_mirror_failure};
 100     $self->{target} = $target;
 101     return bless $self, $class;
 102 }
 103
 104 sub copy_source_required
 105 {
 106     my $self = shift;
 107
 108     # always copy git
 109     return 1;
 110 }
 111
 112 sub copy_source
 113 {
 114     my $self = shift;
 115     my $using_msvc = shift;
 116     my $target = $self->{target};
 117     my $build_path = $self->{build_path};
 118     die "no build path" unless $build_path;
 119
 120     # we don't want to copy the (very large) .git directory
 121     # so we just move it out of the way during the copy
 122     # there might be better ways of doing this, but this should do for now
 123
 124     move "$target/.git", "./git-save";
 125     EximBuild::SCM::copy_source($using_msvc,$target,$build_path);
 126     move "./git-save","$target/.git";
 127 }
 128
 129 sub get_build_path
 130 {
 131     my $self = shift;
 132     my $use_vpath = shift; # irrelevant for git
 133     my $target = $self->{target};
 134     $self->{build_path} = "$target.$$";
 135     return      $self->{build_path};
 136 }
 137
 138 sub check_access
 139 {
 140
 141     # no login required?
 142     return;
 143 }
 144
 145 sub log_id
 146 {
 147     my $self = shift;
 148     main::writelog('githead',[$self->{headref}])
 149       if $self->{headref};
 150 }
 151
 152 sub checkout
 153 {
 154
 155     my $self = shift;
 156     my $branch = shift;
 157     my $gitserver = $self->{gitrepo};
 158     my $target = $self->{target};
 159     my $status;
 160
 161     # Msysgit does some horrible things, especially when it expects a drive
 162     # spec and doesn't get one.  So we extract it if it exists and use it
 163     # where necessary.
 164     my $drive = "";
 165     my $cwd = getcwd();
 166     $drive = substr($cwd,0,2) if $cwd =~ /^[A-Z]:/;
 167
 168     my @gitlog;
 169     if ($self->{mirror})
 170     {
 171
 172         my $mirror = $target eq 'exim' ? 'exim.git' : "$target-exim.git";
 173
 174         if (-d $self->{mirror})
 175         {
 176             @gitlog = `git --git-dir="$self->{mirror}" fetch 2>&1`;
 177             $status = $self->{ignore_mirror_failure} ? 0 : $? >> 8;
 178         }
 179         else
 180         {
 181             my $char1 = substr($gitserver,0,1);
 182             $gitserver = "$drive$gitserver"
 183               if ( $char1 eq '/' or $char1 eq '\\');
 184
 185             # this will fail on older git versions
 186             # workaround is to do this manually in the buildroot:
 187             #   git clone --bare $gitserver exim.git
 188             #   (cd exim.git && git remote add --mirror origin $gitserver)
 189             # or equivalent for other targets
 190             @gitlog = `git clone --mirror $gitserver $self->{mirror} 2>&1`;
 191             $status = $? >>8;
 192         }
 193         if ($status)
 194         {
 195             unshift(@gitlog,"Git mirror failure:\n");
 196             print @gitlog if ($main::verbose);
 197             main::send_result('Git-mirror',$status,\@gitlog);
 198         }
 199     }
 200
 201     push @gitlog, "Git arguments:\n".
 202                   "  branch=$branch gitserver=$gitserver target=$target\n\n";
 203
 204     if (-d $target)
 205     {
 206         # First check and see if git is in path
 207         `which git 2>&1`;
 208         if ($? != 0)
 209         {
 210             my @ret = `env`;
 211             unshift @ret, "git not found in path\n";
 212             main::send_result("$target-Git",$status,\@ret);
 213         }
 214
 215         chdir $target;
 216         my @branches = `git branch 2>&1`;
 217         unless (grep {/^\* bf_\Q$branch\E$/} @branches)
 218         {
 219             chdir '..';
 220             print "Missing checked out branch bf_$branch:\n",@branches
 221               if ($main::verbose);
 222             unshift @branches,"Missing checked out branch bf_$branch in " . cwd() . ":\n";
 223             main::send_result("$target-Git",$status,\@branches);
 224         }
 225         my @pulllog = `git pull --rebase 2>&1`;
 226         push(@gitlog,@pulllog);
 227         chdir '..';
 228     }
 229     else
 230     {
 231         my $reference =
 232           defined($self->{reference}) ?"--reference $self->{reference}" : "";
 233
 234         my $base = $self->{mirror} || $gitserver;
 235
 236         my $char1 = substr($base,0,1);
 237         $base = "$drive$base"
 238           if ( $char1 eq '/' or $char1 eq '\\');
 239
 240         my @clonelog = `git clone -q $reference $base $target 2>&1`;
 241         push(@gitlog,@clonelog);
 242         $status = $? >>8;
 243         if (!$status)
 244         {
 245             chdir $target;
 246
 247             # make sure we don't name the new branch HEAD
 248             # also, safer to checkout origin/master than origin/HEAD, I think
 249             my $rbranch = $branch eq 'HEAD' ? 'master' : $branch;
 250             my @colog =
 251               `git checkout -b bf_$branch --track origin/$rbranch 2>&1`;
 252             push(@gitlog,@colog);
 253             chdir "..";
 254         }
 255     }
 256     $status = $? >>8;
 257     print "================== git log =====================\n",@gitlog
 258       if ($main::verbose > 1);
 259
 260     # can't call writelog here because we call cleanlogs after the
 261     # checkout stage, since we only clear out the logs if we find we need to
 262     # do a build run.
 263     # consequence - we don't save the git log if we don't do a run
 264     # doesn't matter too much because if git fails we exit anyway.
 265
 266     # Don't call git clean here. If the user has left stuff lying around it
 267     # might be important to them, so instead of blowing it away just bitch
 268     # loudly.
 269
 270     chdir "$target";
 271     my @gitstat = `git status --porcelain 2>&1`;
 272     chdir "..";
 273
 274     my ($headref,$refhandle);
 275     if (open($refhandle,"$target/.git/refs/heads/bf_$branch"))
 276     {
 277         $headref = <$refhandle>;
 278         chomp $headref;
 279         close($refhandle);
 280         $self->{headref} = $headref;
 281     }
 282
 283     main::send_result("$target-Git",$status,\@gitlog)   if ($status);
 284     unless ($main::nosend && $main::nostatus)
 285     {
 286         push(@gitlog,"===========",@gitstat);
 287         main::send_result("$target-Git-Dirty",99,\@gitlog)
 288           if (@gitstat);
 289     }
 290
 291     # if we were successful, however, we return the info so that
 292     # we can put it in the newly cleaned logdir  later on.
 293     return \@gitlog;
 294 }
 295
 296 sub cleanup
 297 {
 298     my $self = shift;
 299     my $target = $self->{target};
 300     chdir $target;
 301     system("git clean -dfxq");
 302     chdir "..";
 303 }
 304
 305 # private Class level routine for getting changed file data
 306 sub parse_log
 307 {
 308     my $cmd = shift;
 309     my @lines = `$cmd`;
 310     chomp(@lines);
 311     my $commit;
 312     my $list = {};
 313     foreach my $line (@lines)
 314     {
 315         next if $line =~ /^(Author:|Date:|\s)/;
 316         next unless $line;
 317         if ($line =~ /^commit ([0-9a-zA-Z]+)/)
 318         {
 319             $commit = $1;
 320         }
 321         else
 322         {
 323
 324             # anything else should be a file name
 325             $line =~ s/\s+$//; # make sure all trailing space is trimmed
 326             $list->{$line} ||= $commit; # keep most recent commit
 327         }
 328     }
 329     return $list;
 330 }
 331
 332 sub find_changed
 333 {
 334     my $self = shift;
 335     my $target = $self->{target};
 336     my $current_snap = shift;
 337     my $last_run_snap = shift;
 338     my $last_success_snap = shift || 0;
 339     my $changed_files = shift;
 340     my $changed_since_success = shift;
 341
 342     my $cmd = qq{git --git-dir=$target/.git log -n 1 "--pretty=format:%ct"};
 343     $$current_snap = `$cmd` +0;
 344
 345     # get the list of changed files and stash the commit data
 346
 347     if ($last_run_snap)
 348     {
 349         if ($last_success_snap > 0 && $last_success_snap < $last_run_snap)
 350         {
 351             $last_success_snap++;
 352             my $lrsscmd ="git  --git-dir=$target/.git log --name-only "
 353               ."--since=$last_success_snap --until=$last_run_snap";
 354             $self->{changed_since_success} = parse_log($lrsscmd);
 355         }
 356         else
 357         {
 358             $self->{changed_since_success} = {};
 359         }
 360         $last_run_snap++;
 361         my $lrscmd ="git  --git-dir=$target/.git log --name-only "
 362           ."--since=$last_run_snap";
 363         $self->{changed_since_last_run} = parse_log($lrscmd);
 364         foreach my $file (keys %{$self->{changed_since_last_run}})
 365         {
 366             delete $self->{changed_since_success}->{$file};
 367         }
 368     }
 369     else
 370     {
 371         $self->{changed_since_last_run} = {};
 372     }
 373
 374     @$changed_files = sort keys %{$self->{changed_since_last_run}};
 375     @$changed_since_success = sort keys %{$self->{changed_since_success}};
 376 }
 377
 378 sub get_versions
 379 {
 380     my $self = shift;
 381     my $flist = shift;
 382     return unless @$flist;
 383     my @repoversions;
 384
 385     # for git we have already collected and stashed the info, so we just
 386     # extract it from the stash.
 387
 388     foreach my $file (@$flist)
 389     {
 390         if (exists $self->{changed_since_last_run}->{$file})
 391         {
 392             my $commit = $self->{changed_since_last_run}->{$file};
 393             push(@repoversions,"$file $commit");
 394         }
 395         elsif (exists $self->{changed_since_success}->{$file})
 396         {
 397             my $commit = $self->{changed_since_success}->{$file};
 398             push(@repoversions,"$file $commit");
 399         }
 400     }
 401     @$flist = @repoversions;
 402 }
 403
 404 1;