2 # These two should go upon release to make the script Perl 5.005 compatible
8 make_patchnum.pl - make patchnum
12 miniperl make_patchnum.pl
18 This program creates the files holding the information
19 about locally applied patches to the source code. The created
20 files are F<git_version.h> and F<lib/Config_git.pl>.
22 =head2 F<lib/Config_git.pl>
24 Contains status information from git in a form meant to be processed
25 by the tied hash logic of Config.pm. It is actually optional,
26 although -V:git.\* will be uninformative without it.
28 C<git_version.h> contains similar information in a C header file
29 format, designed to be used by patchlevel.h. This file is obtained
30 from stock_git_version.h if miniperl is not available, and then
31 later on replaced by the version created by this script.
35 Yves Orton, Kenichi Ishigaki, Max Maischein
39 Same terms as Perl itself.
43 # from a -Dmksymlink target dir, I need to cd to the git-src tree to
44 # use git (like script does). Presuming that's not unique, one fix is
45 # to follow Configure's symlink-path to run git. Maybe GIT_DIR or
46 # path-args can solve it, if so we should advise here, I tried only
47 # very briefly ('cd -' works too).
50 our $opt_v = scalar grep $_ eq '-v', @ARGV;
54 while (!-e "$root/perl.c" and length($root)<100) {
61 die "Can't find toplevel" if !-e "$root/perl.c";
62 sub path_to { "$root/$_[0]" } # use $_[0] if this'd be placed in toplevel.
64 # test to see if we're a -Dmksymlinks target dir
67 if (-l "$root/Configure") {
68 $srcdir = readlink("$root/Configure");
69 $srcdir =~ s/Configure//;
70 $subcd = "cd $srcdir &&"; # activate backtick fragment
75 my $file = path_to(@_);
76 return "" unless -e $file;
77 open my $fh, '<', $file
78 or die "Failed to open for read '$file':$!";
79 return do { local $/; <$fh> };
83 my ($file, $content) = @_;
84 $file= path_to($file);
85 open my $fh, '>', $file
86 or die "Failed to open for write '$file':$!";
92 # only for git. If we're in a -Dmksymlinks build-dir, we need to
93 # cd to src so git will work . Probably a better way.
96 my @result= `$subcd $command`;
97 #warn "$subcd $command: \$?=$?\n" if $?;
98 print "#> $subcd $command ->\n @result\n" if !$? and $opt_v;
102 my $result= `$subcd $command`;
103 $result="" if ! defined $result;
104 #warn "$subcd $command: \$?=$?\n" if $?;
105 print "#> $subcd $command ->\n $result\n" if !$? and $opt_v;
112 my %content= map { /WARNING: '([^']+)'/ || die "Bad mojo!"; $1 => $_ } @_;
113 my @files= sort keys %content;
114 my $files= join " and ", map { "'$_'" } @files;
115 foreach my $file (@files) {
116 if (read_file($file) ne $content{$file}) {
117 print "Updating $files\n";
118 write_file($_,$content{$_}) for @files;
122 print "Reusing $files\n";
126 my $unpushed_commits = ' ';
127 my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5;
128 my ($changed, $extra_info, $commit_title)= ("") x 3;
131 if (my $patch_file= read_file(".patch")) {
132 ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file;
133 $extra_info = "git_snapshot_date='$snapshot_created'";
134 $commit_title = "Snapshot of:";
136 elsif ($git_patch_file = read_file(".git_patch") and $git_patch_file !~ /\A\$Format:%H/) {
137 chomp $git_patch_file;
138 ($commit_id, my $commit_date, my $names)
139 = split /\|/, $git_patch_file;
141 my @names = split /,\s*/, $names;
143 ($branch) = map m{^HEAD -> (.*)}, @names;
145 ($branch) = map m{^(blead|maint/.*)}, @names;
148 ($branch) = map m{^tag: (.*)}, @names;
152 my ($pr) = map m{^refs/pull/([0-9]+)/}, @names;
153 $branch = "pull-request-$pr";
156 $branch = $names[0] || $commit_id;
159 $describe ||= $commit_id;
160 $extra_info = "git_commit_date='$commit_date'\n";
161 $extra_info .= "git_snapshot_date='$commit_date'\n";
162 $commit_title = "Snapshot of:";
164 elsif (-d "$srcdir/.git") {
165 # git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }'
166 ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick("git branch");
169 if (length $branch) {
170 $merge= backtick("git config branch.$branch.merge");
171 $merge = "" unless $? == 0;
172 $merge =~ s!^refs/heads/!!;
173 $remote= backtick("git config branch.$branch.remote");
174 $remote = "" unless $? == 0;
176 $commit_id = backtick("git rev-parse HEAD");
177 $describe = backtick("git describe");
178 my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"});
179 $extra_info = "git_commit_date='$commit_created'";
180 backtick("git diff --no-ext-diff --quiet --exit-code");
183 backtick("git diff-index --cached --quiet HEAD --");
187 if (length $branch && length $remote) {
188 # git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//'
189 my $unpushed_commit_list =
190 join ",", map { (split /\s/, $_)[1] }
191 grep {/\+/} backtick("git cherry $remote/$merge");
192 # git cherry $remote/$branch | awk 'BEGIN{ORS="\t\\\\\n"} /\+/ {print ",\"" $2 "\""}'
194 join "", map { ',"'.(split /\s/, $_)[1]."\"\t\\\n" }
195 grep {/\+/} backtick("git cherry $remote/$merge");
196 if (length $unpushed_commits) {
197 $commit_title = "Local Commit:";
198 my $ancestor = backtick("git rev-parse $remote/$merge");
199 $extra_info = "$extra_info
200 git_ancestor='$ancestor'
201 git_remote_branch='$remote/$merge'
202 git_unpushed='$unpushed_commit_list'";
206 $commit_title = "Derived from:";
208 $commit_title ||= "Commit id:";
211 # we extract the filename out of the warning header, so don't mess with that
212 write_files(<<"EOF_HEADER", <<"EOF_CONFIG");
213 /**************************************************************************
214 * WARNING: 'git_version.h' is automatically generated by make_patchnum.pl
215 * DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead
216 ***************************************************************************/
217 @{[$describe ? "#define PERL_PATCHNUM \"$describe\"" : ()]}
218 #define PERL_GIT_UNPUSHED_COMMITS\t\t\\
219 $unpushed_commits/*leave-this-comment*/
220 @{[$changed ? "#define PERL_GIT_UNCOMMITTED_CHANGES" : ()]}
222 ######################################################################
223 # WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl
224 # DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead
225 ######################################################################
226 \$Config::Git_Data=<<'ENDOFGIT';
227 git_commit_id='$commit_id'
228 git_describe='$describe'
230 git_uncommitted_changes='$changed'
231 git_commit_id_title='$commit_title'
235 # ex: set ts=8 sts=4 sw=4 et ft=perl: