File Coverage

blib/lib/SVN/Hooks/CheckStructure.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package SVN::Hooks::CheckStructure;
{
  $SVN::Hooks::CheckStructure::VERSION = '1.27';
}
# ABSTRACT: Check the structure of a repository.

use strict;
use warnings;

use Carp;
use Data::Util qw(:check);
use SVN::Hooks;

use Exporter qw/import/;
my $HOOK = 'CHECK_STRUCTURE';
our @EXPORT = ($HOOK, 'check_structure');


my $Structure;

sub CHECK_STRUCTURE {
    ($Structure) = @_;

    PRE_COMMIT(\&pre_commit);

    return 1;
}

sub _check_structure {
    my ($structure, $path) = @_;

    @$path > 0 or croak "Can't happen!";

    if (is_string($structure)) {
	if ($structure eq 'DIR') {
	    return (1) if @$path > 1;
	    return (0, "the component ($path->[0]) should be a DIR in");
	} elsif ($structure eq 'FILE') {
	    return (0, "the component ($path->[0]) should be a FILE in") if @$path > 1;
	    return (1);
	} elsif (is_integer($structure)) {
	    return (1) if $structure;
	    return (0, "invalid path");
	} else {
	    return (0, "syntax error: unknown string spec ($structure), while checking");
	}
    } elsif (is_array_ref($structure)) {
	return (0, "syntax error: odd number of elements in the structure spec, while checking")
	    unless scalar(@$structure) % 2 == 0;
	return (0, "the component ($path->[0]) should be a DIR in")
	    unless @$path > 1;
	shift @$path;
	# Return ok if the directory doesn't have subcomponents.
	return (1) if @$path == 1 && length($path->[0]) == 0;

	for (my $s=0; $s<$#$structure; $s+=2) {
	    my ($lhs, $rhs) = @{$structure}[$s, $s+1];
	    if (is_string($lhs)) {
		if ($lhs eq $path->[0]) {
		    return _check_structure($rhs, $path);
		} elsif (is_integer($lhs)) {
		    if ($lhs) {
			return _check_structure($rhs, $path);
		    } elsif (is_string($rhs)) {
			return (0, "$rhs, while checking");
		    } else {
			return (0, "syntax error: the right hand side of a number must be string, while checking");
		    }
		}
	    } elsif (is_rx($lhs)) {
		if ($path->[0] =~ $lhs) {
		    return _check_structure($rhs, $path);
		}
	    } else {
		my $what = ref $lhs;
		return (0, "syntax error: the left hand side of arrays in the structure spec must be scalars or qr/Regexes/, not $what, while checking");
	    }
	}
	return (0, "the component ($path->[0]) is not allowed in");
    } else {
	my $what = ref $structure;
	return (0, "syntax error: invalid reference to a $what in the structure spec, while checking");
    }
}


sub check_structure {
    my ($structure, $path) = @_;
    $path = "/$path" unless $path =~ m@^/@; # make sure it's an absolute path
    my @path = split '/', $path, -1; # preserve trailing empty components
    my ($code, $error) = _check_structure($structure, \@path);
    croak "$error: $path\n" if $code == 0;
    return 1;
}

sub pre_commit {
    my ($svnlook) = @_;

    my @errors;

    foreach my $added ($svnlook->added()) {
	# Split the $added path in its components. We prefix $added
	# with a slash to make it look like an absolute path for
	# _check_structure. The '-1' is to preserve trailing empty
	# components so that we can differentiate directory paths from
	# file paths.
	my @added = split '/', "/$added", -1;
	my ($code, $error) = _check_structure($Structure, \@added);
	push @errors, "$error: $added" if $code == 0;
    }

    croak join("\n", "$HOOK:", @errors), "\n"
	if @errors;

    return;
}

1; # End of SVN::Hooks::CheckStructure

__END__