DEVEL/hooksdir/NHgithook.pm

   1 #
   2 # NHgithook.pm
   3 # NetHack Git Hook Module
   4 # $NHDT-Date$
   5
   6 package NHgithook;
   7 use Cwd;
   8
   9 ###
  10 ### CONFIG
  11 ###
  12 my $trace = 0;
  13 my $tracefile = "/tmp/nhgitt.$$";
  14
  15 # OS hackery
  16 my $DS = quotemeta('/');
  17 if ($^O eq "MSWin32")
  18 {
  19     $DS = quotemeta('\\');
  20 }
  21
  22 our %saved_env;
  23 our @saved_argv;
  24 our $saved_input;
  25
  26 sub saveSTDIN {
  27         @saved_input = <STDIN>;
  28
  29         if($trace){
  30                 print TRACE "STDIN:\n";
  31                 print TRACE $saved_input;
  32                 print TRACE "ENDSTDIN\n";
  33         }
  34
  35         tie *STDIN, 'NHIO::STDIN', @saved_input;
  36 }
  37
  38 # XXX this needs a re-write (don't tie and untie, just set NEXT=0)
  39 #  (the sensitive thing is @foo = <STDIN> )
  40 sub resetSTDIN{
  41         my $x = tied(*STDIN);
  42         my %x = %$x;
  43         my $data = @$x{DATA};
  44         untie *STDIN;
  45         tie *STDIN, 'NHIO::STDIN', $data;
  46 }
  47
  48 # don't need this now
  49 #sub restore {
  50 #       open STDIN, "<", \$saved_input or die "reopen STDIN: $!";
  51 #       @ARGV = @saved_argv;
  52 #       %ENV = %saved_env;
  53 #}
  54
  55 sub PRE {
  56         &do_hook("PRE");
  57 }
  58
  59 sub POST {
  60         &do_hook("POST");
  61 }
  62
  63 # PRIVATE
  64 sub do_hook {
  65         my($p) = @_;
  66         my $hname = $0;
  67         $hname =~ s!^((.*$DS)|())(.*)!$1$p-$4!;
  68         if(-x $hname){
  69                 print TRACE "START $p: $hname\n" if($trace);
  70
  71                 open TOHOOK, "|-", $hname or die "open $hname: $!";
  72                 print TOHOOK <STDIN>;
  73                 close TOHOOK or die "close $hname: $! $?";
  74
  75                 print TRACE "END $p\n" if($trace);
  76         }
  77 }
  78
  79 sub trace_start {
  80         return unless($trace);
  81         my $self = shift;
  82         open TRACE, ">>", $tracefile;
  83         print TRACE "START CLIENT PID:$$ ARGV:\n";
  84         print TRACE "CWD: " . cwd() . "\n";
  85         print TRACE "[0] $0\n";
  86         my $x1;
  87         for(my $x=0;$x<scalar @ARGV;$x++){
  88                 $x1 = $x+1;
  89                 print TRACE "[$x1] $ARGV[$x]\n";
  90         }
  91         print TRACE "ENV:\n";
  92         foreach my $k (sort keys %ENV){
  93                 next unless ($k =~ m/(^GIT_)|(^NH)/);
  94                 print TRACE " $k => $ENV{$k}\n";
  95         }
  96 }
  97
  98 BEGIN {
  99         %saved_env = %ENV;
 100         @saved_argv = @ARGV;
 101         &trace_start;
 102 }
 103
 104 ###
 105 ### ugly mess so we can re-read STDIN
 106 ###
 107 package NHIO::STDIN;
 108 sub TIEHANDLE {
 109         my $class = shift;
 110         my %fh;
 111                 # XXX yuck
 112         if(ref @_[0]){
 113                 $fh{DATA} = @_[0];
 114         } else {
 115                 $fh{DATA} = \@_;
 116         }
 117         $fh{NEXT} = 0;
 118         return bless \%fh, $class;
 119 }
 120
 121 sub READLINE {
 122         my $self = shift;
 123         return undef if($self->{EOF});
 124         if(wantarray){
 125                 my $lim = $#{$self->{DATA}};
 126                 my @ary = @{$self->{DATA}}[$self->{NEXT}..$lim];
 127                 my @rv = @ary[$self->{NEXT}..$#ary];
 128                 $self->{EOF} = 1;
 129                 return @rv;
 130         } else{
 131                 my $rv = $self->{DATA}[$self->{NEXT}];
 132                 if(length $rv){
 133                         $self->{NEXT}++;
 134                         return $rv;
 135                 } else {
 136                         $self->{EOF} = 1;
 137                         return undef;
 138                 }
 139         }
 140 }
 141
 142 sub EOF {
 143         $self = shift;
 144         return $self->{EOF};
 145 }
 146
 147 1;
 148 __END__
 149
 150 =head1 NAME
 151
 152 NHgithook - common code for NetHack git hooks (and other git bits)
 153
 154 =head1 SYNOPSIS
 155
 156   BEGIN {
 157         my $DS = quotemeta('/');
 158         my $PDS = '/';
 159         if ($^O eq "MSWin32")
 160         {
 161             $DS = quotemeta('\\');
 162             $PDS = '\\';
 163         }
 164
 165         push(@INC, $ENV{GIT_DIR}.$PDS."hooks");    # for most hooks
 166         push(@INC, ($0 =~ m!^(.*)$DS!)[0]);       # when the above doesn't work
 167
 168         $gitdir = `git rev-parse --git-dir`;      # and when the above really doesn't work
 169         $gitdir =~ s/[\r\n]*$/;
 170         push(@INC, $gitdir.$PDS."hooks");
 171   }
 172   use NHgithook;
 173
 174   &NHgithook::saveSTDIN;
 175   &NHgithook::PRE;
 176   (core hook code)
 177   &NHgithook::POST;
 178
 179 =head1 DESCRIPTION
 180
 181 Buffers call information so multiple independent actions may be coded for
 182 Git hooks and similar Git callouts.
 183
 184 =head1 SETUP
 185
 186 Changing the C<$trace> and C<$tracefile> variables requires editing the
 187 module source.  Setting C<$trace> enables tracing, logs basic information,
 188 and leaves the C<TRACE> filehandle open for additional output; output to this
 189 filehandle must be guarded by C<$NHgithook::trace>.  Setting
 190 C<$tracefile> specifies the file used for trace output.  Note that C<$$>
 191 may be useful since multiple processes may be live at the same time.
 192
 193 =head1 FUNCTIONS
 194
 195   NHgithook::saveSTDIN  reads STDIN until EOF and saves it
 196   NHgithook::PRE        runs the PRE hook, if it exists
 197   NHgithook::POST       runs the POST hook, if it exists
 198
 199 =head1 BUGS
 200
 201 Some features not well tested, especially under Windows.
 202
 203 =head1 AUTHOR
 204
 205 Kenneth Lorber (keni@his.com)