DEVEL/hooksdir/NHtext

   1 #!/usr/bin/perl
   2 #
   3 # NHtext
   4 # $NHDT-Date$
   5 # clean/smudge filter for handling substitutions
   6 use strict;
   7
   8 #my $debug = 0;         # save trace to file
   9 #my $debug2 = 0;                # annotate output when running from command line
  10
  11 #my $sink = ($^O eq "MSWin32")? "NUL" :"/dev/null";
  12 #my $dbgfile = ($^O eq "MSWin32") ? "$ENV{TEMP}.$$" : "/tmp/trace.$$";
  13 #open TRACE, ">>", ($debug==0)? $sink : $dbgfile;
  14
  15 sub git_config {
  16         my($section, $var) = @_;
  17         local($_);
  18                 # Sigh.  Without GIT_DIR we have to do it the slow way, and sometimes we don't
  19                 # have GIT_DIR.
  20         if(0 == length($ENV{GIT_DIR})){
  21                 my $raw = `git config --local --get $section.$var`;
  22                 chomp($raw);
  23                 return $raw
  24         }
  25         open(CONFIG, "<", "$ENV{GIT_DIR}/config") or die "Missing .git/config: $!";
  26         while(<CONFIG>){
  27                 m/^\[$section]/ && do {
  28                         while(<CONFIG>){
  29                                 m/^\s+$var\s+=\s+(.*)/ && do {
  30                                         return $1;
  31                                 };
  32                         }
  33                 };
  34         }
  35         die "Missing config var: [$section] $var\n";
  36 }
  37 # pick up the prefix for substitutions in this repo
  38 my $PREFIX = &git_config('nethack','substprefix');
  39
  40 my $submode = 0;        # ok to make non-cleaning changes to file
  41 my $mode;
  42
  43 if($ARGV[0] eq "--clean"){
  44         $mode = "c";
  45         if(0 == 0+$ENV{NHMODE}){
  46                 $submode = 1;           # do NOT add extra changes to the file
  47 #               print TRACE "SKIPPING\n";
  48         }
  49 } elsif($ARGV[0] eq "--smudge"){
  50         $mode = "s";
  51 } else {
  52         warn "Unknown mode '$ARGV[0]'\n";
  53         exit 1;
  54 }
  55
  56 # XXX for now, there isn't any - if we get called, we subst.  No options for now.
  57 # get relevent config info
  58 #XXX
  59 #git check-attr -a $ARGV[1]
  60
  61 # Process stdin to stdout.
  62 # For speed we read in the entire file then do the substitutions.
  63
  64 local($_) = '';
  65 my $len;
  66 while(1){
  67                 # On at least some systems we only get 64K.
  68         my $len = sysread(STDIN, $_, 999999, length($_));
  69         last if($len == 0);
  70         die "read failed: $!" unless defined($len);
  71 }
  72
  73 # $1 - var and value (including trailing space but not $)
  74 # $2 - var
  75 # $4 - value or undef
  76 #       s/\$$PREFIX-(([A-Za-z][A-Za-z0-9_]*)(: ([^\N{DOLLAR SIGN}]+))?)\$/&handlevar($2,$4)/eg;
  77 s/\$$PREFIX-(([A-Za-z][A-Za-z0-9_]*)(: ([^\x24]+))?)\$/&handlevar($2,$4)/ego;
  78
  79 die "write failed: $!" unless defined syswrite(STDOUT, $_);
  80 exit 0;
  81
  82 sub handlevar {
  83         my($var, $val) = @_;
  84 #       print "HIT '$var' '$val'\n" if($debug2);
  85
  86         my $subname = "PREFIX::$var";
  87         if(defined &$subname){
  88                 no strict;
  89                 $val =~ s/\s+$//;
  90                 $val = &$subname($val,$mode,$submode);
  91         } else {
  92                 warn "No handler for \$$PREFIX-$var\n";
  93         }
  94
  95         if(length $val){
  96                 return "\$$PREFIX-$var: $val \$";
  97         } else {
  98                 return "\$$PREFIX-$var\$";
  99         }
 100 }
 101
 102 package PREFIX;
 103 use POSIX qw(strftime);
 104
 105 # On push, put in the current date because we changed the file.
 106 # On pull, keep the current value so we can see the last change date.
 107 sub Date {
 108         my($val, $mode, $submode) = @_;
 109         if($mode eq "c"){
 110                 if($submode==0){
 111                         # we add this to make merge easier for now XXX
 112                         my $now = time; # not %s below - may not be portable
 113                         # YYYY/MM/DD HH:MM:SS
 114                         $val = "$now " . strftime("%Y/%m/%d %H:%M:%S", gmtime($now));
 115                 }
 116         }
 117 #       if($mode eq "s"){
 118 #       }
 119         return $val;
 120 }
 121
 122 #sub Header {
 123 #}
 124 #sub Author {
 125 #}
 126
 127 # NB: the standard-ish Revision line isn't enough - you need Branch:Revision -
 128 #     but we split it into 2 so we can use the standard processing code on Revision
 129 #     and just slip Branch in.
 130 sub Branch {
 131         my($val, $mode, $submode) = @_;
 132         if($mode eq "c"){
 133                 if($submode==0){
 134                         $val = `git symbolic-ref -q --short HEAD`;
 135                         $val =~ s/[\n\r]*$//;
 136                         $val =~ s/^\*\s*//;
 137                         $val = "(unknown)" unless($val =~ m/^[[:print:]]+$/);
 138                 }
 139         }
 140 #       if($mode eq "s"){
 141 #       }
 142         return $val;
 143 }
 144
 145 sub Revision {
 146         my($val, $mode, $submode) = @_;
 147         if($mode eq "c"){
 148                 if($submode==0){
 149                         my $file = $ARGV[1];
 150                         my @val = `git log --follow --oneline $file`;
 151                         my $ver = 0+$#val;
 152                         $ver = 0 if($ver < 0);
 153                         $val = "1.$ver";
 154                 }
 155         }
 156 #       if($mode eq "s"){
 157 #       }
 158         return $val;
 159 }
 160