7 Copyright (c) 2003-2010, Andrew Dunstan
9 See accompanying License file for license details
13 ##########################################################################
15 # SCM Class and subclasses for specific SCMs (currently CVS and git).
17 #########################################################################
19 package EximBuild::SCM;
21 use vars qw($VERSION); $VERSION = 'REL_0.1';
23 # factory function to return the right subclass
28 my $target = shift || 'exim';
29 if (defined($conf->{scm}) && $conf->{scm} =~ /^git$/i)
32 return new EximBuild::SCM::Git $conf, $target;
34 #elsif ((defined($conf->{scm}) && $conf->{scm} =~ /^cvs$/i )
36 # ||$conf->{cvsmethod})
38 # $conf->{scm} = 'cvs';
39 # return new EximBuild::SCM::CVS $conf, $target;
41 die "only Git currently supported";
44 # common routine use for copying the source, called by the
45 # SCM objects (directly, not as class methods)
48 my $using_msvc = shift;
50 my $build_path = shift;
52 # annoyingly, there isn't a standard perl module to do a recursive copy
53 # and I don't want to require use of the non-standard File::Copy::Recursive
54 system("cp -r $target $build_path 2>&1");
56 die "copying directories: $status" if $status;
60 # required operations in each subclass:
62 # copy_source_required()
72 ##################################
76 ##################################
78 package EximBuild::SCM::Git;
89 $self->{gitrepo} = $conf->{scmrepo} ||
90 "git://git.exim.org/exim.git";
91 $self->{reference} = $conf->{git_reference}
92 if defined($conf->{git_reference});
95 ? "$conf->{build_root}/exim.git"
96 :"$conf->{build_root}/$target-exim.git"
97 )if $conf->{git_keep_mirror};
98 $self->{ignore_mirror_failure} = $conf->{git_ignore_mirror_failure};
99 $self->{target} = $target;
100 return bless $self, $class;
103 sub copy_source_required
114 my $using_msvc = shift;
115 my $target = $self->{target};
116 my $build_path = $self->{build_path};
117 die "no build path" unless $build_path;
119 # we don't want to copy the (very large) .git directory
120 # so we just move it out of the way during the copy
121 # there might be better ways of doing this, but this should do for now
123 move "$target/.git", "./git-save";
124 EximBuild::SCM::copy_source($using_msvc,$target,$build_path);
125 move "./git-save","$target/.git";
131 my $use_vpath = shift; # irrelevant for git
132 my $target = $self->{target};
133 $self->{build_path} = "$target.$$";
134 return $self->{build_path};
147 main::writelog('githead',[$self->{headref}])
156 my $gitserver = $self->{gitrepo};
157 my $target = $self->{target};
160 # Msysgit does some horrible things, especially when it expects a drive
161 # spec and doesn't get one. So we extract it if it exists and use it
165 $drive = substr($cwd,0,2) if $cwd =~ /^[A-Z]:/;
171 my $mirror = $target eq 'exim' ? 'exim.git' : "$target-exim.git";
173 if (-d $self->{mirror})
175 @gitlog = `git --git-dir="$self->{mirror}" fetch 2>&1`;
176 $status = $self->{ignore_mirror_failure} ? 0 : $? >> 8;
180 my $char1 = substr($gitserver,0,1);
181 $gitserver = "$drive$gitserver"
182 if ( $char1 eq '/' or $char1 eq '\\');
184 # this will fail on older git versions
185 # workaround is to do this manually in the buildroot:
186 # git clone --bare $gitserver exim.git
187 # (cd exim.git && git remote add --mirror origin $gitserver)
188 # or equivalent for other targets
189 @gitlog = `git clone --mirror $gitserver $self->{mirror} 2>&1`;
194 unshift(@gitlog,"Git mirror failure:\n");
195 print @gitlog if ($main::verbose);
196 main::send_result('Git-mirror',$status,\@gitlog);
200 push @gitlog, "Git arguments:\n".
201 " branch=$branch gitserver=$gitserver target=$target\n\n";
205 # First check and see if git is in path
210 unshift @ret, "git not found in path\n";
211 main::send_result("$target-Git",$status,\@ret);
215 my @branches = `git branch 2>&1`;
216 unless (grep {/^\* bf_$branch$/} @branches)
219 print "Missing checked out branch bf_$branch:\n",@branches
221 unshift @branches,"Missing checked out branch bf_$branch:\n";
222 main::send_result("$target-Git",$status,\@branches);
224 my @pulllog = `git pull 2>&1`;
225 push(@gitlog,@pulllog);
231 defined($self->{reference}) ?"--reference $self->{reference}" : "";
233 my $base = $self->{mirror} || $gitserver;
235 my $char1 = substr($base,0,1);
236 $base = "$drive$base"
237 if ( $char1 eq '/' or $char1 eq '\\');
239 my @clonelog = `git clone -q $reference $base $target 2>&1`;
240 push(@gitlog,@clonelog);
246 # make sure we don't name the new branch HEAD
247 # also, safer to checkout origin/master than origin/HEAD, I think
248 my $rbranch = $branch eq 'HEAD' ? 'master' : $branch;
250 `git checkout -b bf_$branch --track origin/$rbranch 2>&1`;
251 push(@gitlog,@colog);
256 print "================== git log =====================\n",@gitlog
257 if ($main::verbose > 1);
259 # can't call writelog here because we call cleanlogs after the
260 # checkout stage, since we only clear out the logs if we find we need to
262 # consequence - we don't save the git log if we don't do a run
263 # doesn't matter too much because if git fails we exit anyway.
265 # Don't call git clean here. If the user has left stuff lying around it
266 # might be important to them, so instead of blowing it away just bitch
270 my @gitstat = `git status --porcelain 2>&1`;
273 my ($headref,$refhandle);
274 if (open($refhandle,"$target/.git/refs/heads/bf_$branch"))
276 $headref = <$refhandle>;
279 $self->{headref} = $headref;
282 main::send_result("$target-Git",$status,\@gitlog) if ($status);
283 unless ($main::nosend && $main::nostatus)
285 push(@gitlog,"===========",@gitstat);
286 main::send_result("$target-Git-Dirty",99,\@gitlog)
290 # if we were successful, however, we return the info so that
291 # we can put it in the newly cleaned logdir later on.
298 my $target = $self->{target};
300 system("git clean -dfxq");
304 # private Class level routine for getting changed file data
312 foreach my $line (@lines)
314 next if $line =~ /^(Author:|Date:|\s)/;
316 if ($line =~ /^commit ([0-9a-zA-Z]+)/)
323 # anything else should be a file name
324 $line =~ s/\s+$//; # make sure all trailing space is trimmed
325 $list->{$line} ||= $commit; # keep most recent commit
334 my $target = $self->{target};
335 my $current_snap = shift;
336 my $last_run_snap = shift;
337 my $last_success_snap = shift || 0;
338 my $changed_files = shift;
339 my $changed_since_success = shift;
341 my $cmd = qq{git --git-dir=$target/.git log -n 1 "--pretty=format:%ct"};
342 $$current_snap = `$cmd` +0;
344 # get the list of changed files and stash the commit data
348 if ($last_success_snap > 0 && $last_success_snap < $last_run_snap)
350 $last_success_snap++;
351 my $lrsscmd ="git --git-dir=$target/.git log --name-only "
352 ."--since=$last_success_snap --until=$last_run_snap";
353 $self->{changed_since_success} = parse_log($lrsscmd);
357 $self->{changed_since_success} = {};
360 my $lrscmd ="git --git-dir=$target/.git log --name-only "
361 ."--since=$last_run_snap";
362 $self->{changed_since_last_run} = parse_log($lrscmd);
363 foreach my $file (keys %{$self->{changed_since_last_run}})
365 delete $self->{changed_since_success}->{$file};
370 $self->{changed_since_last_run} = {};
373 @$changed_files = sort keys %{$self->{changed_since_last_run}};
374 @$changed_since_success = sort keys %{$self->{changed_since_success}};
381 return unless @$flist;
384 # for git we have already collected and stashed the info, so we just
385 # extract it from the stash.
387 foreach my $file (@$flist)
389 if (exists $self->{changed_since_last_run}->{$file})
391 my $commit = $self->{changed_since_last_run}->{$file};
392 push(@repoversions,"$file $commit");
394 elsif (exists $self->{changed_since_success}->{$file})
396 my $commit = $self->{changed_since_success}->{$file};
397 push(@repoversions,"$file $commit");
400 @$flist = @repoversions;