DEVEL/hooksdir/nhsub

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