1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
#!/usr/bin/perl
# These two should go upon release to make the script Perl 5.005 compatible
use strict;
use warnings;
=head1 NAME
make_patchnum.pl - make patchnum
=head1 SYNOPSIS
miniperl make_patchnum.pl
perl make_patchnum.pl
=head1 DESCRITPTION
This program creates the files holding the information
about locally applied patches to the source code. The created
files are C<git_version.h> and C<lib/Config_git.pl>.
=item C<lib/Config_git.pl>
Contains status information from git in a form meant to be processed
by the tied hash logic of Config.pm. It is actually optional,
although -V will look strange without it.
C<git_version.h> contains similar information in a C header file
format, designed to be used by patchlevel.h. This file is obtained
from stock_git_version.h if miniperl is not available, and then
later on replaced by the version created by this script.
=head1 AUTHOR
Yves Orton, Kenichi Ishigaki, Max Maischein
=head1 COPYRIGHT
Same terms as Perl itself.
=cut
BEGIN {
my $root=".";
while (!-e "$root/perl.c" and length($root)<100) {
if ($root eq '.') {
$root="..";
} else {
$root.="/..";
}
}
die "Can't find toplevel" if !-e "$root/perl.c";
sub path_to { "$root/$_[0]" } # use $_[0] if this'd be placed in toplevel.
}
sub read_file {
my $file = path_to(@_);
return "" unless -e $file;
open my $fh, '<', $file
or die "Failed to open for read '$file':$!";
return do { local $/; <$fh> };
}
sub write_file {
my ($file, $content) = @_;
$file= path_to($file);
open my $fh, '>', $file
or die "Failed to open for write '$file':$!";
print $fh $content;
close $fh;
}
sub backtick {
my $command = shift;
if (wantarray) {
my @result= `$command`;
chomp @result;
return @result;
} else {
my $result= `$command`;
$result="" if ! defined $result;
chomp $result;
return $result;
}
}
sub write_files {
my %content= map { /WARNING: '([^']+)'/ || die "Bad mojo!"; $1 => $_ } @_;
my @files= sort keys %content;
my $files= join " and ", map { "'$_'" } @files;
foreach my $file (@files) {
if (read_file($file) ne $content{$file}) {
print "Updating $files\n";
write_file($_,$content{$_}) for @files;
return 1;
}
}
print "Reusing $files\n";
return 0;
}
my $unpushed_commits = '/*no-op*/';
my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5;
my ($changed, $extra_info, $commit_title, $new_patchnum, $status)= ("") x 5;
if (my $patch_file= read_file(".patch")) {
($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file;
$extra_info = "git_snapshot_date='$snapshot_created'";
$commit_title = "Snapshot of:";
}
elsif (-d path_to('.git')) {
# git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }'
($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick('git branch');
my ($remote,$merge);
if (length $branch) {
$merge= backtick("git config branch.$branch.merge");
$merge =~ s!^refs/heads/!!;
$remote= backtick("git config branch.$branch.remote");
}
$commit_id = backtick("git rev-parse HEAD");
$describe = backtick("git describe");
my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"});
$new_patchnum = "describe: $describe";
$extra_info = "git_commit_date='$commit_created'";
if (length $branch && length $remote) {
# git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//'
my $unpushed_commit_list =
join ",", map { (split /\s/, $_)[1] }
grep {/\+/} backtick("git cherry $remote/$merge");
# git cherry $remote/$branch | awk 'BEGIN{ORS="\t\\\\\n"} /\+/ {print ",\"" $2 "\""}'
$unpushed_commits =
join "", map { ',"'.(split /\s/, $_)[1]."\"\t\\\n" }
grep {/\+/} backtick("git cherry $remote/$merge");
if (length $unpushed_commits) {
$commit_title = "Local Commit:";
my $ancestor = backtick("git rev-parse $remote/$merge");
$extra_info = "$extra_info
git_ancestor='$ancestor'
git_remote_branch='$remote/$merge'
git_unpushed='$unpushed_commit_list'";
}
}
if ($changed) {
$changed = 'true';
$commit_title = "Derived from:";
$status='"uncommitted-changes"'
} else {
$status='/*clean-working-directory*/'
}
$commit_title ||= "Commit id:";
}
# we extract the filename out of the warning header, so dont mess with that
exit(write_files(<<"EOF_HEADER", <<"EOF_CONFIG"));
/**************************************************************************
* WARNING: 'git_version.h' is automatically generated by make_patchnum.pl
* DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead
***************************************************************************/
#define PERL_GIT_UNCOMMITTED_CHANGES $status
#define PERL_PATCHNUM "$describe"
#define PERL_GIT_UNPUSHED_COMMITS\t\t\\
$unpushed_commits/*leave-this-comment*/
EOF_HEADER
######################################################################
# WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl
# DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead
######################################################################
\$Config::Git_Data=<<'ENDOFGIT';
git_commit_id='$commit_id'
git_describe='$describe'
git_branch='$branch'
git_uncommitted_changes='$changed'
git_commit_id_title='$commit_title'
$extra_info
ENDOFGIT
EOF_CONFIG
# ex: set ts=8 sts=4 sw=4 et ft=perl:
|
