Commit | Line | Data |
---|---|---|
29299e47 | 1 | #!/usr/bin/perl |
f22725be | 2 | # These two should go upon release to make the script Perl 5.005 compatible |
29299e47 YO |
3 | use strict; |
4 | use warnings; | |
5 | ||
786aaa25 | 6 | =head1 NAME |
8ed12dca | 7 | |
786aaa25 | 8 | make_patchnum.pl - make patchnum |
8ed12dca | 9 | |
786aaa25 | 10 | =head1 SYNOPSIS |
8ed12dca | 11 | |
6033099b MM |
12 | miniperl make_patchnum.pl |
13 | ||
14 | perl make_patchnum.pl | |
15 | ||
3f1788e1 | 16 | =head1 DESCRIPTION |
505afc73 | 17 | |
6033099b MM |
18 | This program creates the files holding the information |
19 | about locally applied patches to the source code. The created | |
d9217264 | 20 | files are F<git_version.h> and F<lib/Config_git.pl>. |
505afc73 | 21 | |
f703fc96 | 22 | =head2 F<lib/Config_git.pl> |
505afc73 YO |
23 | |
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, | |
3f1788e1 | 26 | although -V:git.\* will be uninformative without it. |
505afc73 YO |
27 | |
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. | |
32 | ||
33 | =head1 AUTHOR | |
6033099b | 34 | |
505afc73 | 35 | Yves Orton, Kenichi Ishigaki, Max Maischein |
6033099b | 36 | |
505afc73 | 37 | =head1 COPYRIGHT |
6033099b | 38 | |
505afc73 | 39 | Same terms as Perl itself. |
8ed12dca | 40 | |
786aaa25 KI |
41 | =cut |
42 | ||
3f1788e1 JC |
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). | |
48 | ||
49 | my ($subcd, $srcdir); | |
50 | our $opt_v = scalar grep $_ eq '-v', @ARGV; | |
51 | ||
29299e47 YO |
52 | BEGIN { |
53 | my $root="."; | |
54 | while (!-e "$root/perl.c" and length($root)<100) { | |
55 | if ($root eq '.') { | |
91c3081c | 56 | $root=".."; |
505afc73 | 57 | } else { |
91c3081c RGS |
58 | $root.="/.."; |
59 | } | |
29299e47 YO |
60 | } |
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. | |
52ed379e B |
63 | |
64 | # test to see if we're a -Dmksymlinks target dir | |
65 | $subcd = ''; | |
66 | $srcdir = $root; | |
67 | if (-l "$root/Configure") { | |
68 | $srcdir = readlink("$root/Configure"); | |
69 | $srcdir =~ s/Configure//; | |
70 | $subcd = "cd $srcdir &&"; # activate backtick fragment | |
71 | } | |
29299e47 YO |
72 | } |
73 | ||
74 | sub read_file { | |
75 | my $file = path_to(@_); | |
76 | return "" unless -e $file; | |
77 | open my $fh, '<', $file | |
91c3081c | 78 | or die "Failed to open for read '$file':$!"; |
29299e47 YO |
79 | return do { local $/; <$fh> }; |
80 | } | |
81 | ||
82 | sub write_file { | |
83 | my ($file, $content) = @_; | |
84 | $file= path_to($file); | |
85 | open my $fh, '>', $file | |
91c3081c | 86 | or die "Failed to open for write '$file':$!"; |
29299e47 YO |
87 | print $fh $content; |
88 | close $fh; | |
89 | } | |
90 | ||
91 | sub backtick { | |
3f1788e1 JC |
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. | |
29299e47 | 94 | my $command = shift; |
eb5c076f | 95 | if (wantarray) { |
3f1788e1 | 96 | my @result= `$subcd $command`; |
691ce773 | 97 | #warn "$subcd $command: \$?=$?\n" if $?; |
3f1788e1 | 98 | print "#> $subcd $command ->\n @result\n" if !$? and $opt_v; |
eb5c076f YO |
99 | chomp @result; |
100 | return @result; | |
101 | } else { | |
3f1788e1 | 102 | my $result= `$subcd $command`; |
eb5c076f | 103 | $result="" if ! defined $result; |
31b42f2e | 104 | #warn "$subcd $command: \$?=$?\n" if $?; |
3f1788e1 | 105 | print "#> $subcd $command ->\n $result\n" if !$? and $opt_v; |
eb5c076f YO |
106 | chomp $result; |
107 | return $result; | |
108 | } | |
29299e47 | 109 | } |
8ed12dca | 110 | |
eb5c076f YO |
111 | sub write_files { |
112 | my %content= map { /WARNING: '([^']+)'/ || die "Bad mojo!"; $1 => $_ } @_; | |
113 | my @files= sort keys %content; | |
114 | my $files= join " and ", map { "'$_'" } @files; | |
505afc73 | 115 | foreach my $file (@files) { |
eb5c076f YO |
116 | if (read_file($file) ne $content{$file}) { |
117 | print "Updating $files\n"; | |
118 | write_file($_,$content{$_}) for @files; | |
119 | return 1; | |
505afc73 | 120 | } |
eb5c076f YO |
121 | } |
122 | print "Reusing $files\n"; | |
123 | return 0; | |
124 | } | |
8ed12dca | 125 | |
691ce773 | 126 | my $unpushed_commits = ' '; |
eb5c076f | 127 | my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5; |
691ce773 | 128 | my ($changed, $extra_info, $commit_title)= ("") x 3; |
3f1788e1 | 129 | |
d42c7c41 | 130 | my $git_patch_file; |
eb5c076f YO |
131 | if (my $patch_file= read_file(".patch")) { |
132 | ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file; | |
786aaa25 KI |
133 | $extra_info = "git_snapshot_date='$snapshot_created'"; |
134 | $commit_title = "Snapshot of:"; | |
135 | } | |
d42c7c41 GK |
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; | |
140 | ||
141 | my @names = split /,\s*/, $names; | |
142 | ||
143 | ($branch) = map m{^HEAD -> (.*)}, @names; | |
144 | if (!$branch) { | |
145 | ($branch) = map m{^(blead|maint/.*)}, @names; | |
146 | } | |
147 | if (!$branch) { | |
148 | ($branch) = map m{^tag: (.*)}, @names; | |
149 | $describe = $branch; | |
150 | } | |
151 | if (!$branch) { | |
152 | my ($pr) = map m{^refs/pull/([0-9]+)/}, @names; | |
153 | $branch = "pull-request-$pr"; | |
154 | } | |
155 | if (!$branch) { | |
156 | $branch = $names[0] || $commit_id; | |
157 | } | |
158 | ||
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:"; | |
163 | } | |
3f1788e1 | 164 | elsif (-d "$srcdir/.git") { |
786aaa25 | 165 | # git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }' |
ee205375 DM |
166 | ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick("git branch"); |
167 | $branch //= ""; | |
eb5c076f | 168 | my ($remote,$merge); |
786aaa25 | 169 | if (length $branch) { |
505afc73 | 170 | $merge= backtick("git config branch.$branch.merge"); |
326df896 | 171 | $merge = "" unless $? == 0; |
eb5c076f YO |
172 | $merge =~ s!^refs/heads/!!; |
173 | $remote= backtick("git config branch.$branch.remote"); | |
326df896 | 174 | $remote = "" unless $? == 0; |
786aaa25 KI |
175 | } |
176 | $commit_id = backtick("git rev-parse HEAD"); | |
b6194a9d | 177 | $describe = backtick("git describe"); |
786aaa25 | 178 | my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"}); |
786aaa25 | 179 | $extra_info = "git_commit_date='$commit_created'"; |
691ce773 GA |
180 | backtick("git diff --no-ext-diff --quiet --exit-code"); |
181 | $changed = $?; | |
182 | unless ($changed) { | |
183 | backtick("git diff-index --cached --quiet HEAD --"); | |
184 | $changed = $?; | |
185 | } | |
186 | ||
786aaa25 KI |
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] } | |
eb5c076f | 191 | grep {/\+/} backtick("git cherry $remote/$merge"); |
786aaa25 | 192 | # git cherry $remote/$branch | awk 'BEGIN{ORS="\t\\\\\n"} /\+/ {print ",\"" $2 "\""}' |
29299e47 | 193 | $unpushed_commits = |
eb5c076f YO |
194 | join "", map { ',"'.(split /\s/, $_)[1]."\"\t\\\n" } |
195 | grep {/\+/} backtick("git cherry $remote/$merge"); | |
786aaa25 KI |
196 | if (length $unpushed_commits) { |
197 | $commit_title = "Local Commit:"; | |
eb5c076f | 198 | my $ancestor = backtick("git rev-parse $remote/$merge"); |
786aaa25 KI |
199 | $extra_info = "$extra_info |
200 | git_ancestor='$ancestor' | |
eb5c076f | 201 | git_remote_branch='$remote/$merge' |
786aaa25 KI |
202 | git_unpushed='$unpushed_commit_list'"; |
203 | } | |
204 | } | |
691ce773 | 205 | if ($changed) { |
786aaa25 | 206 | $commit_title = "Derived from:"; |
786aaa25 | 207 | } |
eb5c076f | 208 | $commit_title ||= "Commit id:"; |
786aaa25 KI |
209 | } |
210 | ||
2effe01f | 211 | # we extract the filename out of the warning header, so don't mess with that |
16ad9bfa | 212 | write_files(<<"EOF_HEADER", <<"EOF_CONFIG"); |
eb5c076f YO |
213 | /************************************************************************** |
214 | * WARNING: 'git_version.h' is automatically generated by make_patchnum.pl | |
215 | * DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead | |
216 | ***************************************************************************/ | |
691ce773 | 217 | @{[$describe ? "#define PERL_PATCHNUM \"$describe\"" : ()]} |
eb5c076f YO |
218 | #define PERL_GIT_UNPUSHED_COMMITS\t\t\\ |
219 | $unpushed_commits/*leave-this-comment*/ | |
691ce773 | 220 | @{[$changed ? "#define PERL_GIT_UNCOMMITTED_CHANGES" : ()]} |
eb5c076f YO |
221 | EOF_HEADER |
222 | ###################################################################### | |
223 | # WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl | |
224 | # DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead | |
225 | ###################################################################### | |
8ed12dca YO |
226 | \$Config::Git_Data=<<'ENDOFGIT'; |
227 | git_commit_id='$commit_id' | |
228 | git_describe='$describe' | |
229 | git_branch='$branch' | |
230 | git_uncommitted_changes='$changed' | |
231 | git_commit_id_title='$commit_title' | |
232 | $extra_info | |
233 | ENDOFGIT | |
eb5c076f | 234 | EOF_CONFIG |
91c3081c | 235 | # ex: set ts=8 sts=4 sw=4 et ft=perl: |