1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#!/usr/bin/perl
# NetHack 3.6 NHtext $NHDT-Date: 1524689631 2018/04/25 20:53:51 $ $NHDT-Branch: NetHack-3.6.0 $:$NHDT-Revision: 1.8 $
# Copyright (c) 2015 by Kenneth Lorber, Kensington, Maryland
# NetHack may be freely redistributed. See license for details.
# 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;
}
# XXX for now, there isn't any - if we get called, we subst. No options for now.
# get relevent config info
#XXX
#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 XXX
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;
}
|
