[svn.haxx.se] · SVN Dev · SVN Users · SVN Org · TSVN Dev · TSVN Users · Subclipse Dev · Subclipse Users · this month's index

Re: Svnlook equivalent in a perl binding?

From: Eric Gillespie <epg_at_pretzelnet.org>
Date: 2005-04-06 21:21:27 CEST

"Gee-clough, Aaron (NIH/CIT)" <geecla@mail.nih.gov> writes:

> through the bindings. But, like you, I can't find anything in the bindings
> that do this sort of thing.

You didn't look hard enough :). Here's my pre-commit:

use strict;
use warnings;

use File::Basename;

use SVN::Core;
use SVN::Fs;
use SVN::Repos;

our $repo_path;
our $txn_name;
our $txn;
our $repo;
our $fs;
our $txnroot;
our %paths_changed;
our @sorted_paths;
our $author;
our $date;
our $log;
our $headroot;

MAIN: {
    my $hook;
    my $result;

    $repo_path = shift;
    $txn_name = shift;

    $repo = SVN::Repos::open($repo_path);
    $fs = $repo->fs;

    # If a third argument is present, enter debug mode and treat it as
    # a revision to operate on. This masquerades a revroot as a
    # txnroot so we can run this thing interactively against an
    # existing revision.
    if ($txn = shift) {
        $txn_name = $txn;
        $txnroot = $fs->revision_root($txn);
        $author = $fs->revision_prop($txn, 'svn:author');
        $date = $fs->revision_prop($txn, 'svn:date');
        $log = $fs->revision_prop($txn, 'svn:log');
    } else {
        $txn = $fs->open_txn($txn_name);
        $txnroot = $txn->root;
        $author = $txn->prop('svn:author');
        $date = $txn->prop('svn:date');
        $log = $txn->prop('svn:log');
    }

    my $key; my $val;
    my %tmp = %{$txnroot->paths_changed};
    while (($key, $val) = each(%tmp)) {
        $paths_changed{substr($key, 1)} = $val;
    }
    @sorted_paths = sort(keys(%paths_changed));

    $headroot = $fs->revision_root($fs->youngest_rev);

    for $_ (sort(glob("$repo_path/hooks/pre-commit-hooks/*"))) {
        require $_;
        $hook = basename($_);
        $hook =~ s/-/_/g;
        $hook =~ s/^\d*//;
        eval "\$result = \&$hook";
        $@ and die($@);
        if ($result =~ /^[01]$/) {
            if ($result) {
                # Immediately allow the commit.
                exit(0);
            } else {
                # This check is fine with the commit, continue to next check.
                next;
            }
        } else {
            # $result is an error message, deny the commit.
            print(STDERR "\n$result\n");
            exit(1);
        }
    }
}

---------------------------------------------------------------------
To unsubscribe, e-mail: users-unsubscribe@subversion.tigris.org
For additional commands, e-mail: users-help@subversion.tigris.org
Received on Wed Apr 6 23:06:42 2005

This is an archived mail posted to the Subversion Users mailing list.

This site is subject to the Apache Privacy Policy and the Apache Public Forum Archive Policy.