(!!) trigger mechanism... read below

new triggers:

  - PRE_GIT and POST_GIT in gitolite-shell
  - PRE_CREATE and POST_CREATE when a new wild repo is created
  - (POST_COMPILE had already existed)
  - ACCESS_CHECK triggers both in gitolite-shell and the update hook

  - trace() learned to print the file name if called from top level and
    a function name is not available

note: trigger was called 'run-all' and only had POST_COMPILE.  The code
existed in gitolite-shell, but is now moved to Rc.pm.

src/Gitolite/Common.pm

@@ -43,7 +43,12 @@ sub trace {
 
     my $level = shift; return if $ENV{D} < $level;
     my $args = ''; $args = join( ", ", @_ ) if @_;
-    my $sub = ( caller 1 )[3] || ''; $sub =~ s/.*://; $sub .= ' ' x ( 32 - length($sub) );
+    my $sub = ( caller 1 )[3] || ''; $sub =~ s/.*://;
+    if (not $sub) {
+        $sub = ( caller )[1];
+        $sub =~ s(.*/(.*))(($1));
+    }
+    $sub .= ' ' x ( 32 - length($sub) );
     say2 "TRACE $level $sub", ( @_ ? shift : () );
     say2( "TRACE $level " . ( " " x 32 ), $_ ) for @_;
 }

src/Gitolite/Conf/Store.pm

@@ -198,11 +198,15 @@ sub new_repo {
 sub new_wild_repo {
     my ( $repo, $user ) = @_;
     _chdir( $rc{GL_REPO_BASE} );
+
+    trigger('PRE_CREATE', $repo, $user);
     new_repo($repo);
     _print( "$repo.git/gl-creator", $user );
     _print( "$repo.git/gl-perms", "$rc{DEFAULT_ROLE_PERMS}\n" ) if $rc{DEFAULT_ROLE_PERMS};
     # XXX git config, daemon, web...
     # XXX pre-create, post-create
+    trigger('POST_CREATE', $repo, $user);
+
     _chdir( $rc{GL_ADMIN_BASE} );
 }
 

src/Gitolite/Hooks/PostUpdate.pm

@@ -31,7 +31,7 @@ sub post_update {
         tsh_try("git checkout -f --quiet master");
     }
     _system("$ENV{GL_BINDIR}/gitolite compile");
-    _system("$ENV{GL_BINDIR}/gitolite run-all POST_COMPILE");
+    _system("$ENV{GL_BINDIR}/gitolite trigger POST_COMPILE");
 
     exit 0;
 }

src/Gitolite/Hooks/Update.pm

@@ -10,6 +10,7 @@ package Gitolite::Hooks::Update;
 
 use Exporter 'import';
 
+use Gitolite::Rc;
 use Gitolite::Common;
 use Gitolite::Conf::Load;
 
@@ -28,6 +29,7 @@ sub update {
     my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref );
     trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" );
     gl_log( 'update:check', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref, '->', $ret );
+    trigger('ACCESS_CHECK', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref, $ret);
     _die $ret if $ret =~ /DENIED/;
 
     check_vrefs( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa );

src/Gitolite/Rc.pm

@@ -8,6 +8,7 @@ package Gitolite::Rc;
   glrc
   query_rc
   version
+  trigger
 
   $REMOTE_COMMAND_PATT
   $REF_OR_FILENAME_PATT
@@ -114,10 +115,7 @@ sub glrc {
     }
 }
 
-# ----------------------------------------------------------------------
+# exported functions
-# implements 'gitolite query-rc' and 'version'
-# ----------------------------------------------------------------------
-
 # ----------------------------------------------------------------------
 
 my $all  = 0;
@@ -153,6 +151,30 @@ sub version {
     return $version;
 }
 
+sub trigger {
+    my $rc_section = shift;
+
+    if ( exists $rc{$rc_section} ) {
+        if ( ref( $rc{$rc_section} ) ne 'ARRAY' ) {
+            _die "$rc_section section in rc file is not a perl list";
+        } else {
+            for my $s ( @{ $rc{$rc_section} } ) {
+
+                # perl-ism; apart from keeping the full path separate from the
+                # simple name, this also protects %rc from change by implicit
+                # aliasing, which would happen if you touched $s itself
+                my $sfp = "$ENV{GL_BINDIR}/commands/$s";
+
+                _warn("skipped command '$s'"), next if not -x $sfp;
+                trace( 2, "command: $s" );
+                _system( $sfp, @_ );    # they better all return with 0 exit codes!
+            }
+        }
+        return;
+    }
+    trace( 2, "'$rc_section' not found in rc" );
+}
+
 # ----------------------------------------------------------------------
 
 =for args

src/Gitolite/Setup.pm

@@ -36,7 +36,7 @@ sub setup {
     setup_gladmin( $admin, $pubkey, $argv );
 
     _system("$ENV{GL_BINDIR}/gitolite compile");
-    _system("$ENV{GL_BINDIR}/gitolite run-all POST_COMPILE");
+    _system("$ENV{GL_BINDIR}/gitolite trigger POST_COMPILE");
 
     hook_repos();    # all of them, just to be sure
 }

src/gitolite

@@ -69,8 +69,8 @@ if ( $command eq 'setup' ) {
     Gitolite::Conf->import;
     compile(@args);
 
-} elsif ( $command eq 'run-all' ) {
+} elsif ( $command eq 'trigger' ) {
-    run_all(@args);
+    trigger(@args);
 
 } elsif ( -x "$rc{GL_BINDIR}/commands/$command" ) {
     trace( 2, "attempting gitolite command $command" );
@@ -104,27 +104,3 @@ sub run_command {
     _system( $fullpath, @_ );
     exit 0;
 }
-
-sub run_all {
-    my $rc_section = shift;
-
-    if ( exists $rc{$rc_section} ) {
-        if ( ref( $rc{$rc_section} ) ne 'ARRAY' ) {
-            _warn "$rc_section section in rc file is not a perl list";
-        } else {
-            for my $s ( @{ $rc{$rc_section} } ) {
-
-                # perl-ism; apart from keeping the full path separate from the
-                # simple name, this also protects %rc from change by implicit
-                # aliasing, which would happen if you touched $s itself
-                my $sfp = "$ENV{GL_BINDIR}/commands/$s";
-
-                _warn("skipped command '$s'"), next if not -x $sfp;
-                trace( 2, "command: $s" );
-                _system( $sfp, @ARGV );    # they better all return with 0 exit codes!
-            }
-        }
-        return;
-    }
-    trace( 2, "'$rc_section' not found in rc" );
-}

src/gitolite-shell

@@ -79,10 +79,13 @@ sub main {
     my $ret = access( $repo, $user, $aa, 'any' );
     trace( 1, "access($repo, $user, $aa, 'any')", "-> $ret" );
     gl_log( 'gitolite-shell:check', $repo, $user, $aa, 'any', '->', $ret );
+    trigger('ACCESS_CHECK', $repo, $user, $aa, 'any', $ret);
     _die $ret if $ret =~ /DENIED/;
 
     $repo = "'$rc{GL_REPO_BASE}/$repo.git'";
-    exec( "git", "shell", "-c", "$verb $repo" );
+    trigger('PRE_GIT', $repo, $user, $aa, 'any', $verb);
+    _system( "git", "shell", "-c", "$verb $repo" );
+    trigger('POST_GIT', $repo, $user, $aa, 'any', $verb);
 }
 
 # ----------------------------------------------------------------------