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