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