nethack-gwaa-kiwi/nethack
1
0
Fork 0
Code Pull Requests Activity

nhgitset version 4

Browse Source 
To update, run "perl DEVEL/nhgitset.pl"

Fixes:
- "nhcommit -a" has been fixed
- NHDT was hardwired in places
- no longer complain about a missing dat directory outside of the
    NetHack source tree
- make update of gitinfo atomic
- Replace some hardwired directory separators with OS-dependent constructs

Backwards Incompatibilities:
- NH_DATESUB's DATE() is now Date() to match the other variables
- MSYS2 requires an additional Perl package - the MSYS2 docs have
    been updated

New Help System:
- git nhhelp
   This command mirrors "git help" for nh* commands.
- See git nhhelp nhsub for general help on substitution variables

New Substitution Variables:
-Brev()
    An aBREViation of $PREFIX-Branch$:$PREFIX-Revision$ - this
    may help get line length under control in file headers.
-Assert(TYPE=VALUE)
    If TYPE does not match VALUE, do not substitute on this line.
    TYPE P checks VALUE against nethack.substprefix
-Project(arg)
    Returns nethack.projectname if there is no arg and an uppercase
    version if arg is uc.

Other New Features:
- Add nethack.projectname
- Documentation updates - see "git nhhelp nhsub"
- On checkout or merge of a branch, check for nhgitset version updates
  and provide an optional message to the user.
- Move NH_DATESUB substitutions here from cron job to keep dates in sync
- PREFIX-* keywords now available in NH_DATESUB templates
- Support use of nhgitset.pl from a different repo; note that update
  checks will be dependent on keeping the original source repo up-to-date
  and in the same location.
This commit is contained in:
nhkeni
2024-10-07 13:45:35 -04:00
parent dcf18b2b69
commit 36e8d9e6fc
27 changed files with 1412 additions and 677 deletions
Download Patch File Download Diff File Expand all files Collapse all files

311
DEVEL/hooksdir/NHgithook.pm
View File

@@ -16,9 +16,11 @@ my $tracefile = "/tmp/nhgitt.$$";
# OS hackery
my $DS = quotemeta('/');
my $PDS = '/';
if ($^O eq "MSWin32")
{
$DS = quotemeta('\\');
$PDS = '\\';
}
our %saved_env;
@@ -26,25 +28,23 @@ our @saved_argv;
our $saved_input;
sub saveSTDIN {
@saved_input = <STDIN>;
@saved_input = <STDIN>;
if($trace){
print TRACE "STDIN:\n";
print TRACE $saved_input;
print TRACE "ENDSTDIN\n";
}
if($trace){
print TRACE "STDIN:\n";
print TRACE $saved_input;
print TRACE "ENDSTDIN\n";
}
tie *STDIN, 'NHIO::STDIN', @saved_input;
tie *STDIN, 'NHIO::STDIN', @saved_input;
}
# XXX this needs a re-write (don't tie and untie, just set NEXT=0)
# (the sensitive thing is @foo = <STDIN> )
sub resetSTDIN{
my $x = tied(*STDIN);
my %x = %$x;
my $data = @$x{DATA};
untie *STDIN;
tie *STDIN, 'NHIO::STDIN', $data;
my $x = tied(*STDIN);
my %x = %$x;
my $data = @$x{DATA};
untie *STDIN;
tie *STDIN, 'NHIO::STDIN', $data;
}
# don't need this now
@@ -55,21 +55,142 @@ sub resetSTDIN{
#}
sub PRE {
&do_hook("PRE");
&do_hook("PRE");
}
sub POST {
&do_hook("POST");
&do_hook("POST");
}
###
### versioning for nhgitset and friends
###
# values of nethack.setupversion and DEVEL/VERSION:
# 1 is reserved for repos checked out before versioning was added
# 2 used clean/smudge filter, poorly
# 3 was first production version
# 4 added the version file and version checking; nhhelp, NH_DATESUB support, etc.
sub version_in_devel {
# (1) check for a non-null nethack.setuppath - this handles
# any repo that has already been set up (but NOT checking
# out <v4 over >=v4 since nethack.setuppath will exist but
# DEVEL/VERSION will not).
# XXX if the source repo has been removed, we'll fall back to
# the third case - hopefully that's ok.
# XXX there's no way to recover from a missing source repo
# without editing .git/config.
my $path = `git config --local nethack.setuppath`;
chomp $path;
$path =~ s/DEVEL$//; # NOP if config not set
# (2) else check the local directory; that will be correct for NHsource.
if(0 == length $path){
$path = `git rev-parse --show-toplevel`;
chomp $path;
$path = '' unless(-d "$path${PDS}DEVEL");
}
# (3) If that doesn't exist, check using the invocation path; that will be
# correct for other repos during nhgitset (but will also fail for
# checking out 3 over 4).
if(0 == length $path){
# strip out "DEVEL"
$path = ($0 =~ m!^(.*)${PDS}DEVEL${PDS}.*?(*nla:DEVEL)!)[0];
}
# Uh oh?
if(0==length($path) or (! -d "$path${PDS}DEVEL")){
die "Can't locate DEVEL directory in '$path'.";
}
# Handle checking out version <4 over version >=4. If
# this seems to be the situation, don't revert the code.
return 0 if(! -f "$path${PDS}DEVEL${PDS}VERSION");
my $version;
my $verfile = "$path${PDS}DEVEL${PDS}VERSION";
open VERFH,"<",$verfile or die "xCan't open $verfile: $!";
$version = 0+<VERFH>;
my $message = join('',<VERFH>);
close VERFH;
die "Valid version not found in $verfile" unless($version >= 4);
return ($version,$message) if($version > 0);
return 0;
}
sub version_in_git {
my $vtemp = `git config --local --get nethack.setupversion`;
chomp($vtemp);
return $vtemp if($vtemp > 0);
return 0;
}
sub version_set_git {
my $version_new = $_[0];
system("git config nethack.setupversion $version_new");
if($?){
die "Can't set nethack.setupversion $version_new: $?,$!\n";
}
}
###
### store githash and gitbranch in dat/gitinfo.txt
###
# CAUTION! This is run not just from git hooks, but also from
# sys/unix/gitinfo.sh
sub nhversioning {
use strict;
use warnings;
# See if we're (probably) in a "git pull", in which case we need to
# check for upgrades.
my $check_upgrade = 1 if($_[0]);
# Check for pre-v4 source repo.
my $is_sourcerepo;
{
chomp($is_sourcerepo = `git config --type=int --get nethack.is-sourcerepo`);
if(0 == length $is_sourcerepo){ # not set - assume old repo
$is_sourcerepo = 1;
}elsif($is_sourcerepo==1){
;
}elsif($is_sourcerepo==0){
;
}
}
# Skip the skipping tests if we're being called directly.
# NB: post-commit has no args, but that will be caught by
# the next test for non-source repos.
if($#ARGV != -1){
# Skip this if we didn't change branches, but see if we need to warn.
if(defined($ARGV[2]) and ($ARGV[2] == 0)){
# Because we can create an out of sync state, possibly warn.
my $ref = $ARGV[1];
if($is_sourcerepo and (0 != 0+`git diff --name-only $ref $ref^ |grep ^DEVEL|wc -l`)){
warn "WARNING: DEVEL directory changed. Versioning may be inconsistent\n";
}
return
}
}
if($check_upgrade){
my $current_version = version_in_git();
my($new_version,$message) = version_in_devel();
if($new_version > $current_version){
warn "nhgitset.pl and/or related programs have changed.\n";
warn "Please re-run nhgitset.pl to update from version $current_version to $new_version.\n";
if(length $message){
warn "Additional information\n$message\n";
}
}
}
# Skip versioning if we aren't in a source repo.
return if(0==$is_sourcerepo);
my $git_sha = `git rev-parse HEAD`;
$git_sha =~ s/\s+//g;
my $git_branch = `git rev-parse --abbrev-ref HEAD`;
@@ -77,7 +198,14 @@ sub nhversioning {
die "git rev-parse failed" unless(length $git_sha and length $git_branch);
my $exists = 0;
if (open my $fh, '<', 'dat/gitinfo.txt') {
no strict 'refs';
no strict 'subs';
my $file_gitinfo = "dat${PDS}gitinfo.txt";
my $file_gittemp = "dat${PDS}TMPgitinfo.txt";
use strict 'subs';
use strict 'refs';
if (open my $fh, '<', $file_gitinfo) {
$exists = 1;
my $hashok = 0;
my $branchok = 0;
@@ -91,61 +219,71 @@ sub nhversioning {
}
close $fh;
if ($hashok && $branchok) {
print "dat/gitinfo.txt unchanged, githash=".$git_sha."\n";
print "$file_gitinfo unchanged, githash=".$git_sha."\n";
return;
}
} else {
print "WARNING: Can't find dat directory\n" unless(-d "dat");
warn "WARNING: Can't find dat directory\n" unless(-d "dat");
return;
}
if (open my $fh, '>', 'dat/gitinfo.txt') {
if (open my $fh, '>', $file_gittemp) {
my $how = ($exists ? "updated" : "created");
print $fh 'githash='.$git_sha."\n";
print $fh 'gitbranch='.$git_branch."\n";
print "dat/gitinfo.txt ".$how.", githash=".$git_sha."\n";
print "$file_gitinfo ".$how.", githash=".$git_sha."\n";
if(close($fh)){
if(rename($file_gittemp, $file_gitinfo)){
; # all ok
} else {
warn "WARNING: Can't rename $file_gittemp -> $file_gitinfo";
}
} else {
warn "WARNING: Can't close temp file: $!";
}
} else {
print "WARNING: Unable to open dat/gitinfo.txt: $!\n";
warn "WARNING: Unable to open $file_gitinfo: $!\n";
}
}
# PRIVATE
sub do_hook {
my($p) = @_;
my $hname = $0;
$hname =~ s!^((.*$DS)|())(.*)!$1$p-$4!;
if(-x $hname){
print TRACE "START $p: $hname\n" if($trace);
my($p) = @_;
my $hname = $0;
$hname =~ s!^((.*$DS)|())(.*)!$1$p-$4!;
if(-x $hname){
print TRACE "START $p: $hname\n" if($trace);
open TOHOOK, "|-", $hname or die "open $hname: $!";
print TOHOOK <STDIN>;
close TOHOOK or die "close $hname: $! $?";
open TOHOOK, "|-", $hname or die "open $hname: $!";
print TOHOOK <STDIN>;
close TOHOOK or die "close $hname: $! $?";
print TRACE "END $p\n" if($trace);
}
print TRACE "END $p\n" if($trace);
}
}
sub trace_start {
return unless($trace);
my $self = shift;
open TRACE, ">>", $tracefile;
print TRACE "START CLIENT PID:$$ ARGV:\n";
print TRACE "CWD: " . cwd() . "\n";
print TRACE "[0] $0\n";
my $x1;
for(my $x=0;$x<scalar @ARGV;$x++){
$x1 = $x+1;
print TRACE "[$x1] $ARGV[$x]\n";
}
print TRACE "ENV:\n";
foreach my $k (sort keys %ENV){
next unless ($k =~ m/(^GIT_)|(^NH)/);
print TRACE " $k => $ENV{$k}\n";
}
return unless($trace);
my $self = shift;
open TRACE, ">>", $tracefile;
print TRACE "START CLIENT PID:$$ ARGV:\n";
print TRACE "CWD: " . cwd() . "\n";
print TRACE "[0] $0\n";
my $x1;
for(my $x=0;$x<scalar @ARGV;$x++){
$x1 = $x+1;
print TRACE "[$x1] $ARGV[$x]\n";
}
print TRACE "ENV:\n";
foreach my $k (sort keys %ENV){
next unless ($k =~ m/(^GIT_)|(^NH)/);
print TRACE " $k => $ENV{$k}\n";
}
}
BEGIN {
%saved_env = %ENV;
@saved_argv = @ARGV;
&trace_start;
%saved_env = %ENV;
@saved_argv = @ARGV;
&trace_start;
}
###
@@ -153,42 +291,41 @@ BEGIN {
###
package NHIO::STDIN;
sub TIEHANDLE {
my $class = shift;
my %fh;
# XXX yuck
if(ref @_[0]){
$fh{DATA} = @_[0];
} else {
$fh{DATA} = \@_;
}
$fh{NEXT} = 0;
return bless \%fh, $class;
my $class = shift;
my %fh;
if(ref @_[0]){
$fh{DATA} = @_[0];
} else {
$fh{DATA} = \@_;
}
$fh{NEXT} = 0;
return bless \%fh, $class;
}
sub READLINE {
my $self = shift;
return undef if($self->{EOF});
if(wantarray){
my $lim = $#{$self->{DATA}};
my @ary = @{$self->{DATA}}[$self->{NEXT}..$lim];
my @rv = @ary[$self->{NEXT}..$#ary];
$self->{EOF} = 1;
return @rv;
} else{
my $rv = $self->{DATA}[$self->{NEXT}];
if(length $rv){
$self->{NEXT}++;
return $rv;
} else {
$self->{EOF} = 1;
return undef;
}
}
my $self = shift;
return undef if($self->{EOF});
if(wantarray){
my $lim = $#{$self->{DATA}};
my @ary = @{$self->{DATA}}[$self->{NEXT}..$lim];
my @rv = @ary[$self->{NEXT}..$#ary];
$self->{EOF} = 1;
return @rv;
} else{
my $rv = $self->{DATA}[$self->{NEXT}];
if(length $rv){
$self->{NEXT}++;
return $rv;
} else {
$self->{EOF} = 1;
return undef;
}
}
}
sub EOF {
$self = shift;
return $self->{EOF};
$self = shift;
return $self->{EOF};
}
1;
@@ -223,11 +360,20 @@ NHgithook - common code for NetHack git hooks (and other git bits)
(core hook code)
&NHgithook::POST;
__END__
=for nhgitset NHgithook Infrastructure for NetHack git hooks.
=head1 DESCRIPTION
Perl module for infrastructure of NetHack Git hooks.
Buffers call information so multiple independent actions may be coded for
Git hooks and similar Git callouts.
Maintains C<dat/gitinfo.txt>.
Common routines for dealing with nethack.setupversion git config variable.
=head1 SETUP
Changing the C<$trace> and C<$tracefile> variables requires editing the
@@ -247,6 +393,9 @@ may be useful since multiple processes may be live at the same time.
Some features not well tested, especially under Windows.
Not well documented, but almost no one needs to change (or even call)
this code.
=head1 AUTHOR
Kenneth Lorber (keni@his.com)