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;
{
  $SVN::Hooks::VERSION = '1.27';
}
# ABSTRACT: Framework for implementing Subversion hooks

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;

    # 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.27';
}
	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}}) {
	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)

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

# post-lock(repos-path, username)

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

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

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

# post-unlock(repos-path, username)

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

# pre-commit(SVN::Look)

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

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

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

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

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

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

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

# start-commit(repos-path, username, capabilities)

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

## use critic

1; # End of SVN::Hooks

__END__