This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
this seems to work, still not using the perl version, but this works the way it would
[perl5.git] / make_patchnum.pl
CommitLineData
29299e47 1#!/usr/bin/perl
f22725be 2# These two should go upon release to make the script Perl 5.005 compatible
29299e47
YO
3use strict;
4use warnings;
5
786aaa25 6=head1 NAME
8ed12dca 7
786aaa25 8make_patchnum.pl - make patchnum
8ed12dca 9
786aaa25 10=head1 SYNOPSIS
8ed12dca 11
6033099b
MM
12 miniperl make_patchnum.pl
13
14 perl make_patchnum.pl
15
16This program creates the files holding the information
17about locally applied patches to the source code. The created
18files are C<.patchnum>, C<unpushed.h> and C<lib/Config_git.pl>.
19
20C<.patchnum> contains ???
21
22C<lib/Config_git.pl> contains the configuration of git for
23this branch.
24
25C<unpushed.h> contains the local changes that haven't been
26synchronized with the remote repository as configured with
27C<< git configure branch.<current branch>.remote >>
8ed12dca 28
786aaa25
KI
29=cut
30
29299e47
YO
31BEGIN {
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
44sub 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
52sub 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
61sub backtick {
62 my $command = shift;
63 my $result = `$command`;
64 chomp $result;
65 return $result;
66}
8ed12dca 67
786aaa25
KI
68my $existing_patchnum = read_file('.patchnum');
69my $existing_config = read_file('lib/Config_git.pl');
70my $existing_unpushed = read_file('unpushed.h');
8ed12dca 71
786aaa25
KI
72my $unpushed_commits = '/*no-op*/';
73my ($read, $branch, $snapshot_created, $commit_id, $describe);
74my ($changed, $extra_info, $commit_title, $new_patchnum);
b6194a9d
YO
75if (my $patch_file= read_file('.patch')) {
76 ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patchfile;
786aaa25
KI
77 $extra_info = "git_snapshot_date='$snapshot_created'";
78 $commit_title = "Snapshot of:";
79}
80elsif (-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");
b6194a9d 89 $describe = backtick("git describe");
786aaa25
KI
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 "\""}'
29299e47 99 $unpushed_commits =
786aaa25
KI
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
106git_ancestor='$ancestor'
107git_unpushed='$unpushed_commit_list'";
108 }
109 }
110 if (length $changed) {
111 $changed = 'true';
112 $commit_title = "Derived from:";
113 $new_patchnum = "$new_patchnum
114status: uncommitted-changes";
115 }
116 if (not length $commit_title) {
117 $commit_title = "Commit id:";
118 }
119}
120
121my $new_unpushed =<<"EOFTEXT";
8ed12dca 122/*********************************************************************
786aaa25
KI
123* WARNING: unpushed.h is automatically generated by make_patchnum.pl *
124* DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead *
8ed12dca
YO
125*********************************************************************/
126#define PERL_GIT_UNPUSHED_COMMITS $unpushed_commits
127/*leave-this-comment*/
128EOFTEXT
786aaa25
KI
129
130my $new_config =<<"EOFDATA";
8ed12dca 131#################################################################
786aaa25
KI
132# WARNING: lib/Config_git.pl is generated by make_patchnum.pl #
133# DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead #
8ed12dca
YO
134#################################################################
135\$Config::Git_Data=<<'ENDOFGIT';
136git_commit_id='$commit_id'
137git_describe='$describe'
138git_branch='$branch'
139git_uncommitted_changes='$changed'
140git_commit_id_title='$commit_title'
141$extra_info
142ENDOFGIT
143EOFDATA
786aaa25 144
8ed12dca 145# only update the files if necessary, other build product depends on these files
786aaa25
KI
146if (( $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}
152else {
153 print "Reusing .patchnum and lib/Config_git.pl\n"
154}
155
29299e47 156# ex: set ts=4 sts=4 et ft=perl: