This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pass through -s if supplied, instead of defaulting to it
[perl5.git] / make_patchnum.pl
index 95b8db6..3f857b5 100644 (file)
@@ -13,29 +13,58 @@ make_patchnum.pl - make patchnum
 
   perl make_patchnum.pl
 
 
   perl make_patchnum.pl
 
+=head1 DESCRIPTION
+
 This program creates the files holding the information
 about locally applied patches to the source code. The created
 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>.
+files are  F<git_version.h> and F<lib/Config_git.pl>.
+
+=head2 F<lib/Config_git.pl>
+
+Contains status information from git in a form meant to be processed
+by the tied hash logic of Config.pm. It is actually optional,
+although -V:git.\* will be uninformative without it.
+
+C<git_version.h> contains similar information in a C header file
+format, designed to be used by patchlevel.h. This file is obtained
+from stock_git_version.h if miniperl is not available, and then
+later on replaced by the version created by this script.
 
 
-C<.patchnum> contains ???
+=head1 AUTHOR
 
 
-C<lib/Config_git.pl> contains the configuration of git for
-this branch.
+Yves Orton, Kenichi Ishigaki, Max Maischein
 
 
-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 >>
+=head1 COPYRIGHT
+
+Same terms as Perl itself.
 
 =cut
 
 
 =cut
 
+# from a -Dmksymlink target dir, I need to cd to the git-src tree to
+# use git (like script does).  Presuming that's not unique, one fix is
+# to follow Configure's symlink-path to run git.  Maybe GIT_DIR or
+# path-args can solve it, if so we should advise here, I tried only
+# very briefly ('cd -' works too).
+
+my ($subcd, $srcdir);
+our $opt_v = scalar grep $_ eq '-v', @ARGV;
+
 BEGIN {
     my $root=".";
 BEGIN {
     my $root=".";
+    # test 1st to see if we're a -Dmksymlinks target dir
+    $subcd = '';
+    $srcdir = $root;
+    if (-l "./Configure") {
+       $srcdir = readlink("./Configure");
+       $srcdir =~ s/Configure//;
+       $subcd = "cd $srcdir &&"; # activate backtick fragment
+    }
     while (!-e "$root/perl.c" and length($root)<100) {
         if ($root eq '.') {
     while (!-e "$root/perl.c" and length($root)<100) {
         if ($root eq '.') {
-               $root="..";
-       } else {
-               $root.="/..";
-           }
+            $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.
     }
     die "Can't find toplevel" if !-e "$root/perl.c";
     sub path_to { "$root/$_[0]" } # use $_[0] if this'd be placed in toplevel.
@@ -45,7 +74,7 @@ sub read_file {
     my $file = path_to(@_);
     return "" unless -e $file;
     open my $fh, '<', $file
     my $file = path_to(@_);
     return "" unless -e $file;
     open my $fh, '<', $file
-       or die "Failed to open for read '$file':$!";
+        or die "Failed to open for read '$file':$!";
     return do { local $/; <$fh> };
 }
 
     return do { local $/; <$fh> };
 }
 
@@ -53,20 +82,26 @@ sub write_file {
     my ($file, $content) = @_;
     $file= path_to($file);
     open my $fh, '>', $file
     my ($file, $content) = @_;
     $file= path_to($file);
     open my $fh, '>', $file
-       or die "Failed to open for write '$file':$!";
+        or die "Failed to open for write '$file':$!";
     print $fh $content;
     close $fh;
 }
 
 sub backtick {
     print $fh $content;
     close $fh;
 }
 
 sub backtick {
+    # only for git.  If we're in a -Dmksymlinks build-dir, we need to
+    # cd to src so git will work .  Probably a better way.
     my $command = shift;
     if (wantarray) {
     my $command = shift;
     if (wantarray) {
-        my @result= `$command`;
+        my @result= `$subcd $command`;
+        #warn "$subcd $command: \$?=$?\n" if $?;
+        print "#> $subcd $command ->\n @result\n" if !$? and $opt_v;
         chomp @result;
         return @result;
     } else {
         chomp @result;
         return @result;
     } else {
-        my $result= `$command`;
+        my $result= `$subcd $command`;
         $result="" if ! defined $result;
         $result="" if ! defined $result;
+        warn "$subcd $command: \$?=$?\n" if $?;
+        print "#> $subcd $command ->\n $result\n" if !$? and $opt_v;
         chomp $result;
         return $result;
     }
         chomp $result;
         return $result;
     }
@@ -76,39 +111,49 @@ sub write_files {
     my %content= map { /WARNING: '([^']+)'/ || die "Bad mojo!"; $1 => $_ } @_;
     my @files= sort keys %content;
     my $files= join " and ", map { "'$_'" } @files;
     my %content= map { /WARNING: '([^']+)'/ || die "Bad mojo!"; $1 => $_ } @_;
     my @files= sort keys %content;
     my $files= join " and ", map { "'$_'" } @files;
-    foreach my $file (@files) { 
+    foreach my $file (@files) {
         if (read_file($file) ne $content{$file}) {
             print "Updating $files\n";
             write_file($_,$content{$_}) for @files;
             return 1;
         if (read_file($file) ne $content{$file}) {
             print "Updating $files\n";
             write_file($_,$content{$_}) for @files;
             return 1;
-        } 
+        }
     }
     print "Reusing $files\n";
     return 0;
 }
 
     }
     print "Reusing $files\n";
     return 0;
 }
 
-my $unpushed_commits = '/*no-op*/';
+my $unpushed_commits = '    ';
 my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5;
 my ($read, $branch, $snapshot_created, $commit_id, $describe)= ("") x 5;
-my ($changed, $extra_info, $commit_title, $new_patchnum, $status)= ("") x 5;
+my ($changed, $extra_info, $commit_title)= ("") x 3;
+
 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:";
 }
 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')) {
+elsif (-d "$srcdir/.git") {
     # git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }'
     # git branch | awk 'BEGIN{ORS=""} /\*/ { print $2 }'
-    ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick('git branch');
+    ($branch) = map { /\* ([^(]\S*)/ ? $1 : () } backtick("git branch");
+    $branch //= "";
     my ($remote,$merge);
     if (length $branch) {
     my ($remote,$merge);
     if (length $branch) {
-        $merge= backtick("git config branch.$branch.merge"); 
+        $merge= backtick("git config branch.$branch.merge");
+        $merge = "" unless $? == 0;
         $merge =~ s!^refs/heads/!!;
         $remote= backtick("git config branch.$branch.remote");
         $merge =~ s!^refs/heads/!!;
         $remote= backtick("git config branch.$branch.remote");
+        $remote = "" unless $? == 0;
     }
     $commit_id = backtick("git rev-parse HEAD");
     $describe = backtick("git describe");
     my $commit_created = backtick(qq{git log -1 --pretty="format:%ci"});
     }
     $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'";
     $extra_info = "git_commit_date='$commit_created'";
+    backtick("git diff --no-ext-diff --quiet --exit-code");
+    $changed = $?;
+    unless ($changed) {
+        backtick("git diff-index --cached --quiet HEAD --");
+        $changed = $?;
+    }
+
     if (length $branch && length $remote) {
         # git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//'
         my $unpushed_commit_list =
     if (length $branch && length $remote) {
         # git cherry $remote/$branch | awk 'BEGIN{ORS=","} /\+/ {print $2}' | sed -e 's/,$//'
         my $unpushed_commit_list =
@@ -128,25 +173,21 @@ git_unpushed='$unpushed_commit_list'";
         }
     }
     if ($changed) {
         }
     }
     if ($changed) {
-        $changed = 'true';
         $commit_title =  "Derived from:";
         $commit_title =  "Derived from:";
-        $status='"uncommitted-changes"'
-    } else {
-        $status='/*clean-working-directory*/'
     }
     $commit_title ||= "Commit id:";
 }
 
     }
     $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"));
+# we extract the filename out of the warning header, so don't mess with that
+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
 ***************************************************************************/
 /**************************************************************************
 * 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"
+@{[$describe ? "#define PERL_PATCHNUM \"$describe\"" : ()]}
 #define PERL_GIT_UNPUSHED_COMMITS\t\t\\
 $unpushed_commits/*leave-this-comment*/
 #define PERL_GIT_UNPUSHED_COMMITS\t\t\\
 $unpushed_commits/*leave-this-comment*/
+@{[$changed ? "#define PERL_GIT_UNCOMMITTED_CHANGES" : ()]}
 EOF_HEADER
 ######################################################################
 # WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl
 EOF_HEADER
 ######################################################################
 # WARNING: 'lib/Config_git.pl' is generated by make_patchnum.pl
@@ -161,4 +202,4 @@ git_commit_id_title='$commit_title'
 $extra_info
 ENDOFGIT
 EOF_CONFIG
 $extra_info
 ENDOFGIT
 EOF_CONFIG
-# ex: set ts=4 sts=4 et ft=perl:
+# ex: set ts=8 sts=4 sw=4 et ft=perl: