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 ...
  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: