This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
various changes
[perl5.git] / make_patchnum.pl
CommitLineData
786aaa25 1=head1 NAME
8ed12dca 2
786aaa25 3make_patchnum.pl - make patchnum
8ed12dca 4
786aaa25 5=head1 SYNOPSIS
8ed12dca 6
786aaa25 7...
8ed12dca 8
786aaa25
KI
9=cut
10
11use strict;
12use warnings;
8ed12dca 13
786aaa25
KI
14my $existing_patchnum = read_file('.patchnum');
15my $existing_config = read_file('lib/Config_git.pl');
16my $existing_unpushed = read_file('unpushed.h');
8ed12dca 17
786aaa25
KI
18my $unpushed_commits = '/*no-op*/';
19my ($read, $branch, $snapshot_created, $commit_id, $describe);
20my ($changed, $extra_info, $commit_title, $new_patchnum);
b6194a9d
YO
21if (my $patch_file= read_file('.patch')) {
22 ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patchfile;
786aaa25
KI
23 $extra_info = "git_snapshot_date='$snapshot_created'";
24 $commit_title = "Snapshot of:";
25}
26elsif (-d path_to('.git')) {
27 # git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }'
28 $branch = join "", map { (split /\s/, $_)[1] }
29 grep {/\*/} split /\n/, backtick('git branch');
30 my $remote;
31 if (length $branch) {
32 $remote = backtick("git config branch.$branch.remote");
33 }
34 $commit_id = backtick("git rev-parse HEAD");
b6194a9d 35 $describe = backtick("git describe");
786aaa25
KI
36 my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"});
37 $new_patchnum = "describe: $describe";
38 $extra_info = "git_commit_date='$commit_created'";
39 if (length $branch && length $remote) {
40 # git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//'
41 my $unpushed_commit_list =
42 join ",", map { (split /\s/, $_)[1] }
43 grep {/\+/} split /\n/, backtick("git cherry $remote/$branch");
44 # git cherry $remote/$branch | awk 'BEGIN{ORS="\t\\\\\n"} /\+/ {print ",\"" $2 "\""}'
45 $unpushed_commits =
46 join "", map { ',"'.(split /\s/, $_)[1].'"'."\t\\\n" }
47 grep {/\+/} split /\n/, backtick("git cherry $remote/$branch");
48 if (length $unpushed_commits) {
49 $commit_title = "Local Commit:";
50 my $ancestor = backtick("git rev-parse $remote/$branch");
51 $extra_info = "$extra_info
52git_ancestor='$ancestor'
53git_unpushed='$unpushed_commit_list'";
54 }
55 }
56 if (length $changed) {
57 $changed = 'true';
58 $commit_title = "Derived from:";
59 $new_patchnum = "$new_patchnum
60status: uncommitted-changes";
61 }
62 if (not length $commit_title) {
63 $commit_title = "Commit id:";
64 }
65}
66
67my $new_unpushed =<<"EOFTEXT";
8ed12dca 68/*********************************************************************
786aaa25
KI
69* WARNING: unpushed.h is automatically generated by make_patchnum.pl *
70* DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead *
8ed12dca
YO
71*********************************************************************/
72#define PERL_GIT_UNPUSHED_COMMITS $unpushed_commits
73/*leave-this-comment*/
74EOFTEXT
786aaa25
KI
75
76my $new_config =<<"EOFDATA";
8ed12dca 77#################################################################
786aaa25
KI
78# WARNING: lib/Config_git.pl is generated by make_patchnum.pl #
79# DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead #
8ed12dca
YO
80#################################################################
81\$Config::Git_Data=<<'ENDOFGIT';
82git_commit_id='$commit_id'
83git_describe='$describe'
84git_branch='$branch'
85git_uncommitted_changes='$changed'
86git_commit_id_title='$commit_title'
87$extra_info
88ENDOFGIT
89EOFDATA
786aaa25 90
8ed12dca 91# only update the files if necessary, other build product depends on these files
786aaa25
KI
92if (( $existing_patchnum ne $new_patchnum ) || ( $existing_config ne $new_config ) || ( $existing_unpushed ne $new_unpushed )) {
93 print "Updating .patchnum and lib/Config_git.pl\n";
94 write_file('.patchnum', $new_patchnum);
95 write_file('lib/Config_git.pl', $new_config);
96 write_file('unpushed.h', $new_unpushed);
97}
98else {
99 print "Reusing .patchnum and lib/Config_git.pl\n"
100}
101
b6194a9d
YO
102BEGIN {
103 my $root=".";
104 while (!-e "$root/perl.c" and length($root)<100) {
105 if ($root eq '.') {
106 $root="..";
107 } else {
108 $root.="/..";
109 }
110 }
111 die "Can't find toplevel" if !-e "$root/perl.c";
112 sub path_to { "$root/$_[0]" } # use $_[0] if this'd be placed in toplevel.
113}
786aaa25
KI
114
115sub read_file {
b6194a9d
YO
116 my $file = path_to(@_);
117 return "" unless -e $file;
118 open my $fh, '<', $file
119 or die "Failed to open for read '$file':$!";
786aaa25
KI
120 return do { local $/; <$fh> };
121}
122
123sub write_file {
124 my ($file, $content) = @_;
b6194a9d
YO
125 $file= path_to($file);
126 open my $fh, '>', $file
127 or die "Failed to open for write '$file':$!";
786aaa25
KI
128 print $fh $content;
129 close $fh;
130}
131
132sub backtick {
133 my $command = shift;
134 my $result = `$command`;
135 chomp $result;
136 return $result;
137}
b6194a9d 138#$ ts=4:et