DEVEL/hooksdir/nhsub

   1 #!/usr/bin/perl
   2 # $NHDT-Date: 1524689646 2018/04/25 20:54:06 $ Branch: NetHack-3.6.0 $:$NHDT-Revision: 1.7 $
   3 # Copyright (c) 2015 by Kenneth Lorber, Kensington, Maryland
   4 # NetHack may be freely redistributed.  See license for details.
   5
   6 # Note: was originally called nhdate; the rename is not reflected in the code.
   7
   8 use strict;
   9 our %opt;       #cmd v n f F m (other single char, but we don't care)
  10 my $mode;       # a c d f (add, commit, date, date -f)
  11
  12 if(length $ENV{GIT_PREFIX}){
  13         chdir($ENV{GIT_PREFIX}) or die "Can't chdir $ENV{GIT_PREFIX}: $!";
  14 }
  15
  16 #SO how do we know if a file has changed?
  17 #(git status: git status --porcelain --ignored -- FILES.
  18 #maybe + -z but it's a question of rename operations - probably doesn't
  19 # matter, but need to experiment.
  20
  21 # key:  [dacf] first character of opt{cmd} (f if nhsub -f or add -f)
  22 #       first 2 chars of "git status --porcelain --ignored"
  23 # (see "git help status" for table)
  24 # No default.  Undef means something unexpected happened.
  25 my %codes = (
  26         'f M'=>1, 'f D'=>1,             #           [MD]   not updated
  27         'a M'=>0, 'a D'=>0,
  28         'd M'=>0, 'd D'=>0,
  29         'c M'=>0, 'c D'=>0,
  30
  31         'dM '=>0, 'dMM'=>1, 'dMD'=>0,
  32         'aM '=>0, 'aMM'=>1, 'aMD'=>0,
  33         'cM '=>0, 'cMM'=>1, 'cMD'=>0,
  34         'fM '=>0, 'fMM'=>1, 'fMD'=>0,
  35                                 #           M        [ MD]   updated in index
  36
  37         'dA '=>1, 'dAM'=>1, 'dAD'=>1,
  38         'aA '=>1, 'aAM'=>1, 'aAD'=>1,
  39         'cA '=>1, 'cAM'=>1, 'cAD'=>1,
  40         'fA '=>1, 'fAM'=>1, 'fAD'=>1,
  41                                    # A        [ MD]   added to index
  42
  43         'dD '=>0, 'dDM'=>0,
  44         'aD '=>1, 'aDM'=>1,
  45         'cD '=>0, 'cDM'=>0,
  46         'fD '=>1, 'fDM'=>1,
  47                                    # D         [ M]   deleted from index
  48
  49         'dR '=>0, 'dRM'=>1, 'dRD'=>0,
  50         'aR '=>0, 'aRM'=>1, 'aRD'=>0,
  51         'cR '=>0, 'cRM'=>1, 'cRD'=>0,
  52         'fR '=>0, 'fRM'=>1, 'fRD'=>0,
  53                                 #           R        [ MD]   renamed in index
  54
  55         'dC '=>0, 'dCM'=>1, 'dCD'=>0,
  56         'aC '=>0, 'aCM'=>1, 'aCD'=>0,
  57         'cC '=>0, 'cCM'=>1, 'cCD'=>0,
  58         'fC '=>0, 'fCM'=>1, 'fCD'=>0,
  59                                 #           C        [ MD]   copied in index
  60
  61         'aM '=>1, 'aA '=>1, 'aR '=>1, 'aC '=>1,
  62         'fM '=>1, 'fA '=>1, 'fR '=>1, 'fC '=>1,
  63                                    # [MARC]          index and work tree matches
  64
  65         'd M'=>1, 'dMM'=>1, 'dAM'=>1, 'dRM'=>1, 'dCM'=>1,
  66         'a M'=>1, 'aMM'=>1, 'aAM'=>1, 'aRM'=>1, 'aCM'=>1,
  67         'c M'=>1, 'cMM'=>1, 'cAM'=>1, 'cRM'=>1, 'cCM'=>1,
  68         'f M'=>1, 'fMM'=>1, 'fAM'=>1, 'fRM'=>1, 'fCM'=>1,
  69                                    # [ MARC]     M work tree changed since index
  70
  71         'd D'=>0, 'dMD'=>0, 'dAD'=>0, 'dRD'=>0, 'dCD'=>0,
  72         'a D'=>0, 'aMD'=>0, 'aAD'=>0, 'aRD'=>0, 'aCD'=>0,
  73         'c D'=>0, 'cMD'=>0, 'cAD'=>0, 'cRD'=>0, 'cCD'=>0,
  74         'f D'=>0, 'fMD'=>0, 'fAD'=>0, 'fRD'=>0, 'fCD'=>0,
  75                                    # [ MARC]     D    deleted in work tree
  76
  77            # -------------------------------------------------
  78            # DD    unmerged, both deleted
  79            # AU    unmerged, added by us
  80            # UD    unmerged, deleted by them
  81            # UA    unmerged, added by them
  82            # DU    unmerged, deleted by us
  83            # AA    unmerged, both added
  84            # UU    unmerged, both modified
  85            # -------------------------------------------------
  86         'a??'=>1, 'f??'=>1,             # ??    untracked
  87         'd??'=>0, 'c??'=>0,
  88
  89         'f!!'=>1,                       # !!    ignored
  90         'a!!'=>0, 'd!!'=>0, 'c!!'=>0,
  91
  92         'f@@'=>1,                       # @@    internal ignored
  93         'a@@'=>0, 'd@@'=>0, 'c@@'=>0
  94 );
  95
  96 # OS hackery
  97 my $PDS = '/';
  98 if ($^O eq "MSWin32")
  99 {
 100     $PDS = '\\';
 101 }
 102
 103 # various command line options to consider and what the code actually does:
 104 #DONE nhcommit with no files should exit(0)
 105 #DONE nhadd with no files should exit(0)
 106 #DONE commit -a?
 107 #       add root dir
 108 #DONE commit -a + files -> exit(0)
 109 #nothing: commit --interactive/--patch
 110 #nothing: add -i/--interactive --patch/-p?
 111 #nothing: add -u/--update?????? -A/--all/--no-ignore-removal???
 112 #nothing (not quite right): add --no-all --ignore-removal???
 113 #DONE add --refresh
 114 #nothing: add -N/--intent-to-add
 115 #DONE add -n - exit(0)
 116 #DONE add --dry-run - exit 0
 117 #DONE commit --dry-run - exit 0
 118 #DONE?: add foo/\*/x (letting git expand the filenames)
 119
 120 my @rawlist0 = &cmdparse(@ARGV);
 121
 122 # Use git ls-files to expand command line filepaths with wildcards.
 123 # Let's try this for all commands.
 124 my @rawlist;
 125 foreach my $e (@rawlist0){
 126         if($e =~ m/[?*[\\]/){
 127                 my @rv = &lsfiles(undef, $e);
 128                 push(@rawlist, @rv) if(@rv);
 129                 if($opt{f}){
 130                         my @rv = &lsfiles('-i', $e);
 131                         push(@rawlist, @rv) if(@rv);
 132                 }
 133         } else {
 134                 push(@rawlist, $e);
 135         }
 136 }
 137
 138 push(@rawlist,'.') if($#rawlist == -1);
 139
 140 # pick up the prefix for substitutions in this repo
 141 #TEST my $PREFIX = &git_config('nethack','substprefix');
 142 my $PREFIX = "NHDT";
 143 print "PREFIX: '$PREFIX'\n" if($opt{v});
 144
 145 while(@rawlist){
 146         my $raw = shift @rawlist;
 147         if(-f $raw){
 148                 &schedule_work($raw);
 149                 next;
 150         }
 151         if(-d $raw){
 152                 if($raw =~ m!$PDS.git$!o){
 153                         print "SKIP $raw\n" if($opt{v}>=2);
 154                         next;
 155                 }
 156                 opendir RDIR,$raw or die "Can't opendir: $raw";
 157                 local($_);      # needed until perl 5.11.2
 158                 while($_ = readdir RDIR){
 159                         next if(m/^\.\.?$/);
 160                         if(m/^\./ && $opt{f}){
 161                                 print "       IGNORE-f: $raw$PDS$_\n" if($opt{v}>=2);
 162                                 next;
 163                         }
 164                         push(@rawlist, $raw.$PDS.$_);
 165                 }
 166                 closedir RDIR;
 167         }
 168         # ignore other file types
 169         if(! -e $raw){
 170                 print "warning: missing file $raw\n";
 171         }
 172 }
 173
 174 # XXX could batch things up - later
 175
 176 sub schedule_work {
 177         my($file) = @_;
 178         print "CHECK: '$file'\n" if($opt{v}>=2);
 179         local($_) = `git status --porcelain --ignored -- $file`;
 180         my $key = $mode . join('',(m/^(.)(.)/));
 181         if(length $key == 1){
 182                 # Hack.  An unmodified, tracked file produces no output from
 183                 # git status.  Treat as another version of 'ignored'.
 184                 $key .= '@@';
 185         }
 186         $key =~ s/-/ /g;        # for Keni's locally mod'ed git
 187         if(!exists $codes{$key}){
 188                 die "I'm lost.\nK='$key' F=$file\nST=$_";
 189         }
 190         if($codes{$key}==0){
 191                 if($opt{v}>=2){
 192                         print "       IGNORE: $_" if(length);
 193                         print "       IGNORE: !! $file\n" if(!length);
 194                 }
 195                 return;
 196         }
 197         if($opt{F}){
 198                 my $ign = `git check-ignore $file`;
 199                 if($ign !~ m/^\s*$/){
 200                         print "       IGNORE-F: $ign" if($opt{v}>=2);
 201                         return;
 202                 }
 203         }
 204 # FALLTHROUGH and continue
 205 #print     "ACCEPT TEST\n";     # XXXXXXXXXX TEST
 206 #return;
 207
 208         my $attr = `git check-attr NHSUBST -- $file`;
 209         if($attr =~ m/NHSUBST:\s+(.*)/){
 210 # XXX this is a bug in git.  What if the value of an attribute is the
 211 # string "unset"?  Sigh.
 212                 if(! $opt{F}){
 213                         if($1 eq "unset" || $1 eq "unspecified"){
 214                                 print "       NOATTR: $attr" if($opt{v}>=2);
 215                                 return;
 216                         }
 217                 }
 218                 &process_file($file);
 219                 return;
 220         }
 221         die "Can't parse check-attr return: $attr\n";
 222 }
 223
 224 sub process_file {
 225         my($file) = @_;
 226         print "DOFIL: $file\n" if($opt{v}>=1);
 227
 228         # For speed we read in the entire file then do the substitutions.
 229         local($_) = '';
 230         my $len;
 231         open INFILE, "<", $file or die "Can't open $file: $!";
 232         while(1){
 233                         # On at least some systems we only get 64K.
 234                 my $len = sysread(INFILE, $_, 999999, length($_));
 235                 last if($len == 0);
 236                 die "read failed: $!" unless defined($len);
 237         }
 238         close INFILE;
 239
 240         local $::current_file = $file;  # used under handlevar
 241         # $1 - var and value (including trailing space but not $)
 242         # $2 - var
 243         # $4 - value or undef
 244 #s/\$$PREFIX-(([A-Za-z][A-Za-z0-9_]*)(: ([^\N{DOLLAR SIGN}]+))?)\$/&handlevar($2,$4)/eg;
 245 my $count = s/\$$PREFIX-(([A-Za-z][A-Za-z0-9_]*)(: ([^\x24]+))?)\$/&handlevar($2,$4)/eg;
 246 # XXX had o modifier, why?
 247         return unless($count>0);
 248         return if($opt{n});
 249         my $mode = 0777 & (stat($file))[2];
 250
 251         my $ofile = $file . ".nht";
 252         open(TOUT, ">", $ofile) or die "Can't open $ofile";
 253
 254 #       die "write failed: $!" unless defined syswrite(TOUT, $_);
 255         my $offset = 0;
 256         my $sent;
 257 #print STDERR "L=",length,"\n";
 258         while($offset < length){
 259                 $sent = syswrite(TOUT, $_, (length($_) - $offset), $offset);
 260                 die "write failed: $!" unless defined($sent);
 261 #print STDERR "rv=$sent\n";
 262                 last if($sent == (length($_) - $offset));
 263                 $offset += $sent;
 264 #print STDERR "loop: O=$offset\n";
 265         }
 266
 267         close TOUT or die "Can't close $ofile";
 268                 # Do the right thing for *nix and hope for the best elsewhere:
 269         chmod($mode, $ofile)==1 or warn "Can't set filemode on $ofile";
 270         rename $ofile, $file or die "Can't rename $ofile to $file";
 271 }
 272
 273 # XXX docs for --fixup and --squash are wrong in git's synopsis. --file missing
 274 #   --message --template -t
 275 sub cmdparse {
 276         my(@in) = @_;
 277
 278                 # What are we doing?
 279         $opt{cmd} = 'date';     # really nhsub
 280         if($in[0] eq '--add'){
 281                 $opt{cmd} = 'add';
 282                 shift @in;
 283         }
 284         if($in[0] eq '--commit'){
 285                 $opt{cmd} = 'commit';
 286                 shift @in;
 287         }
 288
 289 # add: -n -v
 290 # commit: --dry-run -v
 291 # nhsub: -n -v
 292         while($in[0] =~ m/^-/){
 293                 local($_) = $in[0];
 294                 if($_ eq '--'){
 295                         shift @in;
 296                         last;
 297                 }
 298                 if(m/^--/){
 299                         if($opt{cmd} eq 'add' && $_ eq '--dry-run'){
 300                                 exit 0;
 301                         }
 302                         if($opt{cmd} eq 'commit' && $_ eq '--dry-run'){
 303                                 exit 0;
 304                         }
 305                         if($opt{cmd} eq 'add' && $_ eq '--refresh'){
 306                                 exit 0;
 307                         }
 308                         shift @in;
 309                         next;
 310                 }
 311 # XXX this is messy - time for a rewrite?
 312                 if(m/^-(.*)/){
 313                         foreach my $single ( split(//,$1) ){
 314                                         # don't do -v here from add/commit
 315                                 if($single ne 'v'){
 316                                         # don't use -m from add/commit
 317                                         if($opt{cmd} eq 'date' || $single ne 'm'){
 318                                                 $opt{$single}++;
 319                                         }
 320                                 } elsif($opt{cmd} eq 'date'){
 321                                         $opt{$single}++;
 322                                 }
 323
 324                                 if($opt{cmd} eq 'add' && $single eq 'n'){
 325                                         exit 0;
 326                                 }
 327 #need to deal with options that eat a following element (-m, -F etc etc)
 328 #add: nothing?
 329 #commit: -c -C  -F -m
 330 #   -u<mode> mode is optional
 331 # -S<keyid>  keyid is optional
 332                                 if($opt{cmd} eq 'commit'){
 333                                         if($single =~ m/[uS]/){
 334                                                 last;
 335                                         }
 336                                         if($single =~ m/[cCFm]/){
 337 #XXX this will be a mess if the argument is wrong, but can we tell?  No.
 338                                                 shift @in;
 339                                                 last;
 340                                         }
 341                                 }
 342                         }
 343                 }
 344                 shift @in;
 345         }
 346
 347         ($mode) = ($opt{cmd} =~ m/^(.)/);
 348         $mode = 'f' if($opt{cmd} eq 'date' && ($opt{f}||$opt{F}));
 349         $mode = 'f' if($opt{cmd} eq 'add' && $opt{f});
 350
 351         if($opt{cmd} eq 'add' && $#in == -1){
 352                 exit 0;
 353         }
 354         if($opt{cmd} eq 'commit' && $#in == -1){
 355                 exit 0;
 356         }
 357         if($opt{cmd} eq 'add' && $opt{a} && $#in != -1){
 358                 exit 0;
 359         }
 360         if($opt{cmd} eq 'add' && $opt{a}){
 361                 my $x = `git rev-parse --show-toplevel`;
 362                 $x =~ s/[\n\r]+$//;
 363                 push(@in, $x);
 364         }
 365         return @in;     # this is our file list
 366 }
 367
 368 sub git_config {
 369         my($section, $var) = @_;
 370         my $raw = `git config --local --get $section.$var`;
 371         $raw =~ s/[\r\n]*$//g;
 372         return $raw if(length $raw);
 373         die "Missing config var: [$section] $var\n";
 374 }
 375
 376 sub handlevar {
 377         my($var, $val) = @_;
 378 #       print "HIT '$var' '$val'\n" if($debug2);
 379
 380         my $subname = "PREFIX::$var";
 381         if(defined &$subname){
 382                 no strict;
 383                 print "   SUBIN: $var '$val'\n" if($opt{v}>=3);
 384                 $val =~ s/\s+$//;
 385                 $val = &$subname($val);
 386                 print "   SUBOT: $var '$val'\n" if($opt{v}>=3);
 387         } else {
 388                 warn "No handler for \$$PREFIX-$var\n";
 389         }
 390
 391         if(length $val){
 392                 return "\$$PREFIX-$var: $val \$";
 393         } else {
 394                 return "\$$PREFIX-$var\$";
 395         }
 396 }
 397
 398 sub lsfiles {
 399         my ($flags, $ps) = @_;
 400         open RV, "-|", "git ls-files $flags '$ps'" or die "Can't ls-files";
 401         my @rv = <RV>;
 402         map { s/[\r\n]+$// } @rv;
 403         if(!close RV){
 404                 return undef if($! == 0);
 405                 die "close ls-files failed: $!";
 406         }
 407         return undef if($#rv == -1);
 408         return @rv;
 409 }
 410
 411 package PREFIX;
 412 use POSIX qw(strftime);
 413
 414 # On push, put in the current date because we changed the file.
 415 # On pull, keep the current value so we can see the last change date.
 416 sub Date {
 417         my($val) = @_;
 418         my $now;
 419         if($opt{m}){
 420                 my $hash = `git log -1 '--format=format:%H' $::current_file`;
 421                         #author keni <keni@his.com> 1429884677 -0400
 422                 chomp($now = `git cat-file -p $hash | awk '/author/{print \$4}'`);
 423         } else {
 424                 $now = time;
 425         }
 426         # YYYY/MM/DD HH:MM:SS
 427         $val = "$now " . strftime("%Y/%m/%d %H:%M:%S", gmtime($now));
 428         return $val;
 429 }
 430
 431 #sub Header {
 432 #}
 433 #sub Author {
 434 #}
 435
 436 # NB: the standard-ish Revision line isn't enough - you need Branch:Revision -
 437 #     but we split it into 2 so we can use the standard processing code on Revision
 438 #     and just slip Branch in.
 439 sub Branch {
 440         my($val) = @_;
 441         $val = `git symbolic-ref -q --short HEAD`;
 442         $val =~ s/[\n\r]*$//;
 443         $val =~ s/^\*\s*//;
 444         $val = "(unknown)" unless($val =~ m/^[[:print:]]+$/);
 445         return $val;
 446 }
 447
 448 sub Revision {
 449         my($val) = @_;
 450         my @val = `git log --follow --oneline $::current_file`;
 451         my $ver = 0+$#val;
 452         $ver = 0 if($ver < 0);
 453         $val = "1.$ver";
 454         return $val;
 455 }
 456 __END__
 457
 458 =head1 NAME
 459
 460 C<nhsub> - NetHack git command for substitution variables
 461
 462 =head1 SYNOPSIS
 463
 464 C<git nhsub [-v[v[v]] [-n] [-f|-F] [-m] [--] [file...]>
 465
 466 =head1 DESCRIPTION
 467
 468 C<nhsub> rewrites the specified files by doing variable substitution for
 469 variables starting with the prefix specified in the repository's
 470 C<nethack.substprefix> configuration variable.  C<nhsub> is also invoked
 471 internally from the implementation of the C<nhadd> and C<nhcommit>
 472 commands.
 473
 474 The program re-writes those files listed on the command line; if the file
 475 is actually a directory, the program recurses into that directory tree.
 476 Not all files found are re-written; some are ignored and those with no
 477 substitution variables are not re-written.  Unless changed by the options,
 478 files that have not changed are not affected.
 479
 480 If no files are listed on the command line, the current directory is
 481 checked as if specified as C<.>.
 482 Files listed directly on the command line are always checked.
 483 The C<.git> directory is never processed.
 484
 485 The following command line options are available:
 486
 487 =over
 488
 489 =item C<-v[v[v]]>
 490
 491 Verbose output; may be (usefully) specified up to 3 times.  Not available
 492 when invoked as part of C<nhadd> or C<nhcommit>.
 493
 494 =item C<-n>
 495
 496 Do not write any files.
 497
 498 =item C<-f>
 499
 500 Force, version 1:
 501 Perform substitution even if the file has not changed,
 502 except no dot files are processed unless listed directly on the command line.
 503 This prevents accidents with editor temporary files while recursing.  Note
 504 that this overloads the C<-f> option of C<git add> and C<git commit>.
 505
 506 =item C<-F>
 507
 508 Force, version 2:
 509 Perform substitution even if the file has not changed,
 510 even if the NHSUBST attribute is not set for the
 511 file, and only if the file is not ignored by git.  Not available
 512 when invoked as part of C<nhadd> or C<nhcommit>.
 513
 514 =item C<-m>
 515
 516 Use metadata (C<git log> and C<git cat-file>) to find the last change date to
 517 substitute.  Often used with C<-f>.  This is useful for cleaning up dates in files that were not
 518 updated when last changed. (Do not use C<git nhadd>/C<git nhcommit> after C<nhsub -m>
 519 or the changes will be overwritten with the current date.)
 520
 521 =back