Added config.w32 to win32/.gitignore

[perl5.git] / make_patchnum.pl

diff --git a/make_patchnum.pl b/make_patchnum.pl
index 5b85b51..e93015f 100644 (file)
--- a/make_patchnum.pl
+++ b/make_patchnum.pl
@@ -1,16 +1,69 @@
+#!/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
 
-use strict;
-use warnings;
-no warnings 'uninitialized';
+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;
+    my $result = `$command`;
+    chomp $result;
+    return $result;
+}
 
 my $existing_patchnum = read_file('.patchnum');
 my $existing_config   = read_file('lib/Config_git.pl');
@@ -19,10 +72,8 @@ my $existing_unpushed = read_file('unpushed.h');
 my $unpushed_commits = '/*no-op*/';
 my ($read, $branch, $snapshot_created, $commit_id, $describe);
 my ($changed, $extra_info, $commit_title, $new_patchnum);
-if (-s path_to('.patch')) {
-    open my $fh, '<', path_to('.patch') or die "Failed to read .patch:$!";
-    ($read, $branch, $snapshot_created, $commit_id, $describe) = map { chomp $_; $_ } <$fh>;
-    $changed = '';
+if (my $patch_file= read_file('.patch')) {
+    ($branch, $snapshot_created, $commit_id, $describe) = split /\s+/, $patchfile;
     $extra_info = "git_snapshot_date='$snapshot_created'";
     $commit_title = "Snapshot of:";
 }
@@ -35,7 +86,7 @@ elsif (-d path_to('.git')) {
         $remote = backtick("git config branch.$branch.remote");
     }
     $commit_id = backtick("git rev-parse HEAD");
-    $describe = backtick("git describe --tags");
+    $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'";
@@ -45,7 +96,7 @@ elsif (-d path_to('.git')) {
             join ",", map { (split /\s/, $_)[1] }
             grep {/\+/} split /\n/, backtick("git cherry $remote/$branch");
         # git cherry $remote/$branch | awk 'BEGIN{ORS="\t\\\\\n"} /\+/ {print ",\"" $2 "\""}'
-        $unpushed_commits = 
+        $unpushed_commits =
             join "", map { ',"'.(split /\s/, $_)[1].'"'."\t\\\n" }
             grep {/\+/} split /\n/, backtick("git cherry $remote/$branch");
         if (length $unpushed_commits) {
@@ -102,26 +153,4 @@ else {
     print "Reusing .patchnum and lib/Config_git.pl\n"
 }
 
-sub path_to { "../$_[0]" } # use $_[0] if this'd be placed in toplevel.
-
-sub read_file {
-    my $file = shift;
-    return unless -f path_to($file);
-    open my $fh, '<', path_to($file) or die "Failed to open $file:$!";
-    return do { local $/; <$fh> };
-}
-
-sub write_file {
-    my ($file, $content) = @_;
-    open my $fh, '>', path_to($file) or die "Failed to open $file:$!";
-    print $fh $content;
-    close $fh;
-}
-
-sub backtick {
-    my $command = shift;
-    my $result = `$command`;
-    chomp $result;
-    return $result;
-}
-
+# ex: set ts=4 sts=4 et ft=perl: