summaryrefslogtreecommitdiff
path: root/make_patchnum.pl
blob: 95b8db61377c1aae809d0ed30337d1ee0ed23c25 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
#!/usr/bin/perl
# These two should go upon release to make the script Perl 5.005 compatible
use strict;
use warnings;

=head1 NAME

make_patchnum.pl - make patchnum

=head1 SYNOPSIS

  miniperl make_patchnum.pl

  perl make_patchnum.pl

This program creates the files holding the information
about locally applied patches to the source code. The created
files are C<.patchnum>, C<unpushed.h> and C<lib/Config_git.pl>.

C<.patchnum> contains ???

C<lib/Config_git.pl> contains the configuration of git for
this branch.

C<unpushed.h> contains the local changes that haven't been
synchronized with the remote repository as configured with
C<< git configure branch.<current branch>.remote >>

=cut

BEGIN {
    my $root=".";
    while (!-e "$root/perl.c" and length($root)<100) {
        if ($root eq '.') {
	        $root="..";
    	} else {
	        $root.="/..";
	    }
    }
    die "Can't find toplevel" if !-e "$root/perl.c";
    sub path_to { "$root/$_[0]" } # use $_[0] if this'd be placed in toplevel.
}

sub read_file {
    my $file = path_to(@_);
    return "" unless -e $file;
    open my $fh, '<', $file
	or die "Failed to open for read '$file':$!";
    return do { local $/; <$fh> };
}

sub write_file {
    my ($file, $content) = @_;
    $file= path_to($file);
    open my $fh, '>', $file
	or die "Failed to open for write '$file':$!";
    print $fh $content;
    close $fh;
}

sub backtick {
    my $command = shift;
    if (wantarray) {
        my @result= `$command`;
        chomp @result;
        return @result;
    } else {
        my $result= `$command`;
        $result="" if ! defined $result;
        chomp $result;
        return $result;
    }
}

sub write_files {
    my %content= map { /WARNING: '([^']+)'/ || die "Bad mojo!"; $1 => $_ } @_;
    my @files= sort keys %content;
    my $files= join " and ", map { "'$_'" } @files;
    foreach my $file (@files) { 
        if (read_file($file) ne $content{$file}) {
            print "Updating $files\n";
            write_file($_,$content{$_}) for @files;
            return 1;
        } 
    }
    print "Reusing $files\n";
    return 0;
}

my $unpushed_commits = '/*no-op*/';
my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5;
my ($changed, $extra_info, $commit_title, $new_patchnum, $status)= ("") x 5;
if (my $patch_file= read_file(".patch")) {
    ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patch_file;
    $extra_info = "git_snapshot_date='$snapshot_created'";
    $commit_title = "Snapshot of:";
}
elsif (-d path_to('.git')) {
    # git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }'
    ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick('git branch');
    my ($remote,$merge);
    if (length $branch) {
        $merge= backtick("git config branch.$branch.merge"); 
        $merge =~ s!^refs/heads/!!;
        $remote= backtick("git config branch.$branch.remote");
    }
    $commit_id = backtick("git rev-parse HEAD");
    $describe = backtick("git describe");
    my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"});
    $new_patchnum = "describe: $describe";
    $extra_info = "git_commit_date='$commit_created'";
    if (length $branch && length $remote) {
        # git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//'
        my $unpushed_commit_list =
            join ",", map { (split /\s/, $_)[1] }
            grep {/\+/} backtick("git cherry $remote/$merge");
        # git cherry $remote/$branch | awk 'BEGIN{ORS="\t\\\\\n"} /\+/ {print ",\"" $2 "\""}'
        $unpushed_commits =
            join "", map { ',"'.(split /\s/, $_)[1]."\"\t\\\n" }
            grep {/\+/} backtick("git cherry $remote/$merge");
        if (length $unpushed_commits) {
            $commit_title = "Local Commit:";
            my $ancestor = backtick("git rev-parse $remote/$merge");
            $extra_info = "$extra_info
git_ancestor='$ancestor'
git_remote_branch='$remote/$merge'
git_unpushed='$unpushed_commit_list'";
        }
    }
    if ($changed) {
        $changed = 'true';
        $commit_title =  "Derived from:";
        $status='"uncommitted-changes"'
    } else {
        $status='/*clean-working-directory*/'
    }
    $commit_title ||= "Commit id:";
}

# we extract the filename out of the warning header, so dont mess with that
exit(write_files(<<"EOF_HEADER", <<"EOF_CONFIG"));
/**************************************************************************
* WARNING: 'git_version.h' is automatically generated by make_patchnum.pl
*          DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead
***************************************************************************/
#define PERL_GIT_UNCOMMITTED_CHANGES $status
#define PERL_PATCHNUM "$describe"
#define PERL_GIT_UNPUSHED_COMMITS\t\t\\
$unpushed_commits/*leave-this-comment*/
EOF_HEADER
######################################################################
# WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl
#          DO NOT EDIT DIRECTLY - edit make_patchnum.pl instead
######################################################################
\$Config::Git_Data=<<'ENDOFGIT';
git_commit_id='$commit_id'
git_describe='$describe'
git_branch='$branch'
git_uncommitted_changes='$changed'
git_commit_id_title='$commit_title'
$extra_info
ENDOFGIT
EOF_CONFIG
# ex: set ts=4 sts=4 et ft=perl: