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