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