143003dfeSmillert#!/usr/bin/perl 243003dfeSmillert# These two should go upon release to make the script Perl 5.005 compatible 343003dfeSmillertuse strict; 443003dfeSmillertuse warnings; 543003dfeSmillert 643003dfeSmillert=head1 NAME 743003dfeSmillert 843003dfeSmillertmake_patchnum.pl - make patchnum 943003dfeSmillert 1043003dfeSmillert=head1 SYNOPSIS 1143003dfeSmillert 1243003dfeSmillert miniperl make_patchnum.pl 1343003dfeSmillert 1443003dfeSmillert perl make_patchnum.pl 1543003dfeSmillert 1643003dfeSmillert=head1 DESCRIPTION 1743003dfeSmillert 1843003dfeSmillertThis program creates the files holding the information 1943003dfeSmillertabout locally applied patches to the source code. The created 20898184e3Ssthenfiles are F<git_version.h> and F<lib/Config_git.pl>. 2143003dfeSmillert 2291f110e0Safresh1=head2 F<lib/Config_git.pl> 2343003dfeSmillert 2443003dfeSmillertContains status information from git in a form meant to be processed 2543003dfeSmillertby the tied hash logic of Config.pm. It is actually optional, 2643003dfeSmillertalthough -V:git.\* will be uninformative without it. 2743003dfeSmillert 2843003dfeSmillertC<git_version.h> contains similar information in a C header file 2943003dfeSmillertformat, designed to be used by patchlevel.h. This file is obtained 3043003dfeSmillertfrom stock_git_version.h if miniperl is not available, and then 3143003dfeSmillertlater on replaced by the version created by this script. 3243003dfeSmillert 3343003dfeSmillert=head1 AUTHOR 3443003dfeSmillert 3543003dfeSmillertYves Orton, Kenichi Ishigaki, Max Maischein 3643003dfeSmillert 3743003dfeSmillert=head1 COPYRIGHT 3843003dfeSmillert 3943003dfeSmillertSame terms as Perl itself. 4043003dfeSmillert 4143003dfeSmillert=cut 4243003dfeSmillert 4343003dfeSmillert# from a -Dmksymlink target dir, I need to cd to the git-src tree to 4443003dfeSmillert# use git (like script does). Presuming that's not unique, one fix is 4543003dfeSmillert# to follow Configure's symlink-path to run git. Maybe GIT_DIR or 4643003dfeSmillert# path-args can solve it, if so we should advise here, I tried only 4743003dfeSmillert# very briefly ('cd -' works too). 4843003dfeSmillert 4943003dfeSmillertmy ($subcd, $srcdir); 5043003dfeSmillertour $opt_v = scalar grep $_ eq '-v', @ARGV; 5143003dfeSmillert 5243003dfeSmillertBEGIN { 5343003dfeSmillert my $root="."; 5443003dfeSmillert while (!-e "$root/perl.c" and length($root)<100) { 5543003dfeSmillert if ($root eq '.') { 5643003dfeSmillert $root=".."; 5743003dfeSmillert } else { 5843003dfeSmillert $root.="/.."; 5943003dfeSmillert } 6043003dfeSmillert } 6143003dfeSmillert die "Can't find toplevel" if !-e "$root/perl.c"; 6243003dfeSmillert sub path_to { "$root/$_[0]" } # use $_[0] if this'd be placed in toplevel. 63*e0680481Safresh1 64*e0680481Safresh1 # test to see if we're a -Dmksymlinks target dir 65*e0680481Safresh1 $subcd = ''; 66*e0680481Safresh1 $srcdir = $root; 67*e0680481Safresh1 if (-l "$root/Configure") { 68*e0680481Safresh1 $srcdir = readlink("$root/Configure"); 69*e0680481Safresh1 $srcdir =~ s/Configure//; 70*e0680481Safresh1 $subcd = "cd $srcdir &&"; # activate backtick fragment 71*e0680481Safresh1 } 7243003dfeSmillert} 7343003dfeSmillert 7443003dfeSmillertsub read_file { 7543003dfeSmillert my $file = path_to(@_); 7643003dfeSmillert return "" unless -e $file; 7743003dfeSmillert open my $fh, '<', $file 7843003dfeSmillert or die "Failed to open for read '$file':$!"; 7943003dfeSmillert return do { local $/; <$fh> }; 8043003dfeSmillert} 8143003dfeSmillert 8243003dfeSmillertsub write_file { 8343003dfeSmillert my ($file, $content) = @_; 8443003dfeSmillert $file= path_to($file); 8543003dfeSmillert open my $fh, '>', $file 8643003dfeSmillert or die "Failed to open for write '$file':$!"; 8743003dfeSmillert print $fh $content; 8843003dfeSmillert close $fh; 8943003dfeSmillert} 9043003dfeSmillert 9143003dfeSmillertsub backtick { 9243003dfeSmillert # only for git. If we're in a -Dmksymlinks build-dir, we need to 9343003dfeSmillert # cd to src so git will work . Probably a better way. 9443003dfeSmillert my $command = shift; 9543003dfeSmillert if (wantarray) { 9643003dfeSmillert my @result= `$subcd $command`; 97b39c5158Smillert #warn "$subcd $command: \$?=$?\n" if $?; 9843003dfeSmillert print "#> $subcd $command ->\n @result\n" if !$? and $opt_v; 9943003dfeSmillert chomp @result; 10043003dfeSmillert return @result; 10143003dfeSmillert } else { 10243003dfeSmillert my $result= `$subcd $command`; 10343003dfeSmillert $result="" if ! defined $result; 104b8851fccSafresh1 #warn "$subcd $command: \$?=$?\n" if $?; 10543003dfeSmillert print "#> $subcd $command ->\n $result\n" if !$? and $opt_v; 10643003dfeSmillert chomp $result; 10743003dfeSmillert return $result; 10843003dfeSmillert } 10943003dfeSmillert} 11043003dfeSmillert 11143003dfeSmillertsub write_files { 11243003dfeSmillert my %content= map { /WARNING: '([^']+)'/ || die "Bad mojo!"; $1 => $_ } @_; 11343003dfeSmillert my @files= sort keys %content; 11443003dfeSmillert my $files= join " and ", map { "'$_'" } @files; 11543003dfeSmillert foreach my $file (@files) { 11643003dfeSmillert if (read_file($file) ne $content{$file}) { 11743003dfeSmillert print "Updating $files\n"; 11843003dfeSmillert write_file($_,$content{$_}) for @files; 11943003dfeSmillert return 1; 12043003dfeSmillert } 12143003dfeSmillert } 12243003dfeSmillert print "Reusing $files\n"; 12343003dfeSmillert return 0; 12443003dfeSmillert} 12543003dfeSmillert 126b39c5158Smillertmy $unpushed_commits = ' '; 12743003dfeSmillertmy ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5; 128b39c5158Smillertmy ($changed, $extra_info, $commit_title)= ("") x 3; 12943003dfeSmillert 13056d68f1eSafresh1my $git_patch_file; 13143003dfeSmillertif (my $patch_file= read_file(".patch")) { 13243003dfeSmillert ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file; 13343003dfeSmillert $extra_info = "git_snapshot_date='$snapshot_created'"; 13443003dfeSmillert $commit_title = "Snapshot of:"; 13543003dfeSmillert} 13656d68f1eSafresh1elsif ($git_patch_file = read_file(".git_patch") and $git_patch_file !~ /\A\$Format:%H/) { 13756d68f1eSafresh1 chomp $git_patch_file; 13856d68f1eSafresh1 ($commit_id, my $commit_date, my $names) 13956d68f1eSafresh1 = split /\|/, $git_patch_file; 14056d68f1eSafresh1 14156d68f1eSafresh1 my @names = split /,\s*/, $names; 14256d68f1eSafresh1 14356d68f1eSafresh1 ($branch) = map m{^HEAD -> (.*)}, @names; 14456d68f1eSafresh1 if (!$branch) { 14556d68f1eSafresh1 ($branch) = map m{^(blead|maint/.*)}, @names; 14656d68f1eSafresh1 } 14756d68f1eSafresh1 if (!$branch) { 14856d68f1eSafresh1 ($branch) = map m{^tag: (.*)}, @names; 14956d68f1eSafresh1 $describe = $branch; 15056d68f1eSafresh1 } 15156d68f1eSafresh1 if (!$branch) { 15256d68f1eSafresh1 my ($pr) = map m{^refs/pull/([0-9]+)/}, @names; 15356d68f1eSafresh1 $branch = "pull-request-$pr"; 15456d68f1eSafresh1 } 15556d68f1eSafresh1 if (!$branch) { 15656d68f1eSafresh1 $branch = $names[0] || $commit_id; 15756d68f1eSafresh1 } 15856d68f1eSafresh1 15956d68f1eSafresh1 $describe ||= $commit_id; 16056d68f1eSafresh1 $extra_info = "git_commit_date='$commit_date'\n"; 16156d68f1eSafresh1 $extra_info .= "git_snapshot_date='$commit_date'\n"; 16256d68f1eSafresh1 $commit_title = "Snapshot of:"; 16356d68f1eSafresh1} 16443003dfeSmillertelsif (-d "$srcdir/.git") { 165*e0680481Safresh1 ($branch) = backtick("git symbolic-ref -q HEAD") =~ m#^refs/heads/(.+)$#; 166898184e3Ssthen $branch //= ""; 16743003dfeSmillert my ($remote,$merge); 16843003dfeSmillert if (length $branch) { 16943003dfeSmillert $merge= backtick("git config branch.$branch.merge"); 170b39c5158Smillert $merge = "" unless $? == 0; 17143003dfeSmillert $merge =~ s!^refs/heads/!!; 17243003dfeSmillert $remote= backtick("git config branch.$branch.remote"); 173b39c5158Smillert $remote = "" unless $? == 0; 17443003dfeSmillert } 17543003dfeSmillert $commit_id = backtick("git rev-parse HEAD"); 17643003dfeSmillert $describe = backtick("git describe"); 17743003dfeSmillert my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"}); 17843003dfeSmillert $extra_info = "git_commit_date='$commit_created'"; 179b39c5158Smillert backtick("git diff --no-ext-diff --quiet --exit-code"); 180b39c5158Smillert $changed = $?; 181b39c5158Smillert unless ($changed) { 182b39c5158Smillert backtick("git diff-index --cached --quiet HEAD --"); 183b39c5158Smillert $changed = $?; 184b39c5158Smillert } 185b39c5158Smillert 18643003dfeSmillert if (length $branch && length $remote) { 18743003dfeSmillert # git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//' 18843003dfeSmillert my $unpushed_commit_list = 18943003dfeSmillert join ",", map { (split /\s/, $_)[1] } 19043003dfeSmillert grep {/\+/} backtick("git cherry $remote/$merge"); 19143003dfeSmillert # git cherry $remote/$branch | awk 'BEGIN{ORS="\t\\\\\n"} /\+/ {print ",\"" $2 "\""}' 19243003dfeSmillert $unpushed_commits = 19343003dfeSmillert join "", map { ',"'.(split /\s/, $_)[1]."\"\t\\\n" } 19443003dfeSmillert grep {/\+/} backtick("git cherry $remote/$merge"); 19543003dfeSmillert if (length $unpushed_commits) { 19643003dfeSmillert $commit_title = "Local Commit:"; 19743003dfeSmillert my $ancestor = backtick("git rev-parse $remote/$merge"); 19843003dfeSmillert $extra_info = "$extra_info 19943003dfeSmillertgit_ancestor='$ancestor' 20043003dfeSmillertgit_remote_branch='$remote/$merge' 20143003dfeSmillertgit_unpushed='$unpushed_commit_list'"; 20243003dfeSmillert } 20343003dfeSmillert } 204b39c5158Smillert if ($changed) { 20543003dfeSmillert $commit_title = "Derived from:"; 20643003dfeSmillert } 20743003dfeSmillert $commit_title ||= "Commit id:"; 20843003dfeSmillert} 20943003dfeSmillert 2106fb12b70Safresh1# we extract the filename out of the warning header, so don't mess with that 21143003dfeSmillertwrite_files(<<"EOF_HEADER", <<"EOF_CONFIG"); 21243003dfeSmillert/************************************************************************** 21343003dfeSmillert* WARNING: 'git_version.h' is automatically generated by make_patchnum.pl 21443003dfeSmillert* DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead 21543003dfeSmillert***************************************************************************/ 216b39c5158Smillert@{[$describe ? "#define PERL_PATCHNUM \"$describe\"" : ()]} 21743003dfeSmillert#define PERL_GIT_UNPUSHED_COMMITS\t\t\\ 21843003dfeSmillert$unpushed_commits/*leave-this-comment*/ 219b39c5158Smillert@{[$changed ? "#define PERL_GIT_UNCOMMITTED_CHANGES" : ()]} 22043003dfeSmillertEOF_HEADER 22143003dfeSmillert###################################################################### 22243003dfeSmillert# WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl 22343003dfeSmillert# DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead 22443003dfeSmillert###################################################################### 22543003dfeSmillert\$Config::Git_Data=<<'ENDOFGIT'; 22643003dfeSmillertgit_commit_id='$commit_id' 22743003dfeSmillertgit_describe='$describe' 22843003dfeSmillertgit_branch='$branch' 22943003dfeSmillertgit_uncommitted_changes='$changed' 23043003dfeSmillertgit_commit_id_title='$commit_title' 23143003dfeSmillert$extra_info 23243003dfeSmillertENDOFGIT 23343003dfeSmillertEOF_CONFIG 23443003dfeSmillert# ex: set ts=8 sts=4 sw=4 et ft=perl: 235