nethack/DEVEL/hooksdir/NHtext

#!/usr/bin/perl
# NetHack 3.7  NHtext       $NHDT-Date: 1596498408 2020/08/03 23:46:48 $  $NHDT-Branch: NetHack-3.7 $:$NHDT-Revision: 1.9 $
# Copyright (c) 2015 by Kenneth Lorber, Kensington, Maryland
# NetHack may be freely redistributed.  See license for details.

# Not in use as of v3, but could come back in the future.

# clean/smudge filter for handling substitutions
use strict;

#my $debug = 0;		# save trace to file
#my $debug2 = 0;		# annotate output when running from command line

#my $sink = ($^O eq "MSWin32")? "NUL" :"/dev/null";
#my $dbgfile = ($^O eq "MSWin32") ? "$ENV{TEMP}.$$" : "/tmp/trace.$$";
#open TRACE, ">>", ($debug==0)? $sink : $dbgfile;

sub git_config {
	my($section, $var) = @_;
	local($_);
		# Sigh.  Without GIT_DIR we have to do it the slow way, and sometimes we don't
		# have GIT_DIR.
	if(0 == length($ENV{GIT_DIR})){
		my $raw = `git config --local --get $section.$var`;
		chomp($raw);
		return $raw
	}
	open(CONFIG, "<", "$ENV{GIT_DIR}/config") or die "Missing .git/config: $!";
	while(<CONFIG>){
		m/^\[$section]/ && do {
			while(<CONFIG>){
				m/^\s+$var\s+=\s+(.*)/ && do {
					return $1;
				};
			}
		};
	}
	die "Missing config var: [$section] $var\n";
}
# pick up the prefix for substitutions in this repo
my $PREFIX = &git_config('nethack','substprefix');

my $submode = 0;	# ok to make non-cleaning changes to file
my $mode;

if($ARGV[0] eq "--clean"){
	$mode = "c";
	if(0 == 0+$ENV{NHMODE}){
		$submode = 1;		# do NOT add extra changes to the file
#		print TRACE "SKIPPING\n";
	}
} elsif($ARGV[0] eq "--smudge"){
	$mode = "s";
} else {
	warn "Unknown mode '$ARGV[0]'\n";
	exit 1;
}

# XX for now, there isn't any - if we get called, we subst.  No options for now.
# get relevant config info
#XX
#git check-attr -a $ARGV[1]

# Process stdin to stdout.
# For speed we read in the entire file then do the substitutions.

local($_) = '';
my $len;
while(1){
		# On at least some systems we only get 64K.
	my $len = sysread(STDIN, $_, 999999, length($_));
	last if($len == 0);
	die "read failed: $!" unless defined($len);
}

# $1 - var and value (including trailing space but not $)
# $2 - var
# $4 - value or undef
#	s/\$$PREFIX-(([A-Za-z][A-Za-z0-9_]*)(: ([^\N{DOLLAR SIGN}]+))?)\$/&handlevar($2,$4)/eg;
s/\$$PREFIX-(([A-Za-z][A-Za-z0-9_]*)(: ([^\x24]+))?)\$/&handlevar($2,$4)/ego;

die "write failed: $!" unless defined syswrite(STDOUT, $_);
exit 0;

sub handlevar {
	my($var, $val) = @_;
#	print "HIT '$var' '$val'\n" if($debug2);

	my $subname = "PREFIX::$var";
	if(defined &$subname){
		no strict;
		$val =~ s/\s+$//;
		$val = &$subname($val,$mode,$submode);
	} else {
		warn "No handler for \$$PREFIX-$var\n";
	}

	if(length $val){
		return "\$$PREFIX-$var: $val \$";
	} else {
		return "\$$PREFIX-$var\$";
	}
}

package PREFIX;
use POSIX qw(strftime);

# On push, put in the current date because we changed the file.
# On pull, keep the current value so we can see the last change date.
sub Date {
	my($val, $mode, $submode) = @_;
	if($mode eq "c"){
		if($submode==0){
			# we add this to make merge easier for now XX
			my $now = time; # not %s below - may not be portable
			# YYYY/MM/DD HH:MM:SS
			$val = "$now " . strftime("%Y/%m/%d %H:%M:%S", gmtime($now));
		}
	}
#	if($mode eq "s"){
#	}
	return $val;
}

#sub Header {
#}
#sub Author {
#}

# NB: the standard-ish Revision line isn't enough - you need Branch:Revision -
#     but we split it into 2 so we can use the standard processing code on Revision
#     and just slip Branch in.
sub Branch {
	my($val, $mode, $submode) = @_;
	if($mode eq "c"){
		if($submode==0){
			$val = `git symbolic-ref -q --short HEAD`;
			$val =~ s/[\n\r]*$//;
			$val =~ s/^\*\s*//;
			$val = "(unknown)" unless($val =~ m/^[[:print:]]+$/);
		}
	}
#	if($mode eq "s"){
#	}
	return $val;
}

sub Revision {
	my($val, $mode, $submode) = @_;
	if($mode eq "c"){
		if($submode==0){
			my $file = $ARGV[1];
			my @val = `git log --follow --oneline $file`;
			my $ver = 0+$#val;
			$ver = 0 if($ver < 0);
			$val = "1.$ver";
		}
	}
#	if($mode eq "s"){
#	}
	return $val;
}