File Coverage

blib/lib/SVN/Hooks.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package SVN::Hooks;
# ABSTRACT: Framework for implementing Subversion hooks
$SVN::Hooks::VERSION = '1.34';
use strict;
use warnings;

use File::Basename;
use File::Spec::Functions;
use Data::Util qw(:check);
use SVN::Look;

use Exporter qw/import/;

our @EXPORT = qw/run_hook POST_COMMIT POST_LOCK POST_REVPROP_CHANGE
                 POST_UNLOCK PRE_COMMIT PRE_LOCK PRE_REVPROP_CHANGE
                 PRE_UNLOCK START_COMMIT/;

our @Conf_Files = (catfile('conf', 'svn-hooks.conf'));
our $Repo       = undef;
our %Hooks      = ();

sub run_hook {
    my ($hook_name, $repo_path, @args) = @_;

    $hook_name = basename $hook_name;

    -d $repo_path or die "not a directory ($repo_path): $_\n";

    $Repo = $repo_path;

    # Allow all hooks assume they execute on the repository's root directory
    chdir $repo_path or die "cannot chdir to $repo_path: $!\n";

    # Reload all configuration files
    foreach my $conf (@Conf_Files) {
	my $conffile = file_name_is_absolute($conf) ? $conf : catfile($Repo, $conf);
	next unless -e $conffile; # Configuration files are optional

        # The configuration file must be evaluated in the main:: namespace
	package main;
$main::VERSION = '1.34';
unless (my $return = do $conffile) {
	    die "couldn't parse '$conffile': $@\n" if $@;
	    die "couldn't do '$conffile': $!\n"    unless defined $return;
	    die "couldn't run '$conffile'\n"       unless $return;
	}
    }

    # Substitute a SVN::Look object for the first argument
    # in the hooks where this makes sense.
    if ($hook_name eq 'pre-commit') {
	# The next arg is a transaction number
	$repo_path = SVN::Look->new($repo_path, '-t' => $args[0]);
    } elsif ($hook_name =~ /^(?:post-commit|(?:pre|post)-revprop-change)$/) {
	# The next arg is a revision number
	$repo_path = SVN::Look->new($repo_path, '-r' => $args[0]);
    }

    foreach my $hook (@{$Hooks{$hook_name}{list}}) {
	if (is_code_ref($hook)) {
	    $hook->($repo_path, @args);
	} elsif (is_array_ref($hook)) {
	    foreach my $h (@$hook) {
		$h->($repo_path, @args);
	    }
	} else {
	    die "SVN::Hooks: internal error!\n";
	}
    }

    return;
}

## no critic (Subroutines::ProhibitSubroutinePrototypes)

# post-commit(SVN::Look, revision, txn-name)

sub POST_COMMIT (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'post-commit'}{set}{$hook}) {
        push @{$Hooks{'post-commit'}{list}},
            ($Hooks{'post-commit'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# post-lock(repos-path, username)

sub POST_LOCK (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'post-lock'}{set}{$hook}) {
        push @{$Hooks{'post-lock'}{list}},
            ($Hooks{'post-lock'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# post-revprop-change(SVN::Look, revision, username, property-name, action)

sub POST_REVPROP_CHANGE (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'post-revprop-change'}{set}{$hook}) {
        push @{$Hooks{'post-revprop-change'}{list}},
            ($Hooks{'post-revprop-change'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# post-unlock(repos-path, username)

sub POST_UNLOCK (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'post-unlock'}{set}{$hook}) {
        push @{$Hooks{'post-unlock'}{list}},
            ($Hooks{'post-unlock'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# pre-commit(SVN::Look, txn-name)

sub PRE_COMMIT (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'pre-commit'}{set}{$hook}) {
        push @{$Hooks{'pre-commit'}{list}},
            ($Hooks{'pre-commit'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# pre-lock(repos-path, path, username, comment, steal-lock-flag)

sub PRE_LOCK (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'pre-lock'}{set}{$hook}) {
        push @{$Hooks{'pre-lock'}{list}},
            ($Hooks{'pre-lock'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# pre-revprop-change(SVN::Look, revision, username, property-name, action)

sub PRE_REVPROP_CHANGE (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'pre-revprop-change'}{set}{$hook}) {
        push @{$Hooks{'pre-revprop-change'}{list}},
            ($Hooks{'pre-revprop-change'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# pre-unlock(repos-path, path, username, lock-token, break-unlock-flag)

sub PRE_UNLOCK (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'pre-unlock'}{set}{$hook}) {
        push @{$Hooks{'pre-unlock'}{list}},
            ($Hooks{'pre-unlock'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

# <  1.8: start-commit(repos-path, username, capabilities)
# >= 1.8: start-commit(repos-path, username, capabilities, txn-name)

# Subversion 1.8 added a txn-name argument to the start-commit. However it's
# only good to get at the commit properties but not to know about the files
# being changed by the commit, which would allow us to use the start-commit
# to perform many of the checks that we perform currently in the pre-commit
# hook. So, for now I'm not going to use the new argument to construct a
# SVN::Look object, since it is mostly useless anyway.

sub START_COMMIT (&) {
    my ($hook) = @_;
    unless (exists $Hooks{'start-commit'}{set}{$hook}) {
        push @{$Hooks{'start-commit'}{list}},
            ($Hooks{'start-commit'}{set}{$hook} = sub { $hook->(@_); });
    }
    return;
}

## use critic

1; # End of SVN::Hooks

__END__