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

Re: Properties via hook?

From: J Robert Ray <jrray_at_imageworks.com>
Date: 2004-10-19 21:41:23 CEST

J Robert Ray wrote:
> I hacked something like this in a post-commit hook, but I didn't like
> how it effectively made many commits increase the revision number twice,
> and how it makes your wc out of date right after committing.

I have attached the script for reference. It is based on the
commit-email.pl file. It is unfinished and full of debug output, I
don't recommend actually using this script.

Looking over it again, I remember better why I abandoned the idea.
Since you can't do a propset on a URL, I have to do a temporary checkout
to set properties. I do a full checkout/propset/commit for each file
that needs to have its properties updated, even if all the files are in
the same directory.

- Robert

#!/usr/local/bin/perl -w

# ====================================================================
# commit-email.pl: send a commit email for commit REVISION in
# repository REPOS to some email addresses.
#
# For usage, see the usage subroutine or run the script with no
# command line arguments.
#
# $HeadURL: http://svn.collab.net/repos/svn/branches/1.0.0/tools/hook-scripts/commit-email.pl.in $
# $LastChangedDate: 2004-02-12 04:07:35 -0600 (Thu, 12 Feb 2004) $
# $LastChangedBy: dlr $
# $LastChangedRevision: 8621 $
#
# ====================================================================
# Copyright (c) 2000-2004 CollabNet. All rights reserved.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at http://subversion.tigris.org/license-1.html.
# If newer versions of this license are posted there, you may use a
# newer version instead, at your option.
#
# This software consists of voluntary contributions made by many
# individuals. For exact contribution history, see the revision
# history and logs, available at http://subversion.tigris.org/.
# ====================================================================

# The warning switch is set here and not in the shebang line above
# with /usr/bin/env because env will try to find the binary named
# 'perl -w', which won't work.
BEGIN
  {
    $^W = 1;
  }

use strict;
use Carp;
use File::Temp qw/tempdir/;
use Data::Dumper;

######################################################################
# Configuration section.

# Svn path.
my $svn = "/usr/local/bin/svn";

# Svnlook path.
my $svnlook = "/usr/local/bin/svnlook";

# Since the path to svnlook depends upon the local installation
# preferences, check that the required programs exist to insure that
# the administrator has set up the script properly.
{
  my $ok = 1;
  foreach my $program ($svn, $svnlook)
    {
      if (-e $program)
        {
          unless (-x $program)
            {
              warn "$0: required program `$program' is not executable, ",
                   "edit $0.\n";
              $ok = 0;
            }
        }
      else
        {
          warn "$0: required program `$program' does not exist, edit $0.\n";
          $ok = 0;
        }
    }
  exit 1 unless $ok;
}

######################################################################
# Initial setup/command-line handling.

# Process the command line arguments till there are none left. The
# first two arguments that are not used by a command line option are
# the repository path and the revision number.
my $urlbase;
my $repos;
my $rev;

($urlbase, $repos, $rev) = ($ARGV[0], $ARGV[1], $ARGV[2]);

$urlbase =~ s|/+$||;

# Check the validity of the command line arguments. Check that the
# revision is an integer greater than 0 and that the repository
# directory exists.
unless ($rev =~ /^\d+/ and $rev > 0)
  {
    &usage("$0: revision number `$rev' must be an integer > 0.");
  }
unless (-e $repos)
  {
    &usage("$0: repos directory `$repos' does not exist.");
  }
unless (-d _)
  {
    &usage("$0: repos directory `$repos' is not a directory.");
  }

######################################################################
# Harvest data using svnlook.

# Change into /tmp so that svnlook diff can create its .svnlook
# directory.
my $tmp_dir = '/tmp';
chdir($tmp_dir)
  or die "$0: cannot chdir `$tmp_dir': $!\n";

# Figure out what files have changed using svnlook.
my @svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev);

# Parse the changed nodes.
my @adds;
my @dels;
my @mods;
foreach my $line (@svnlooklines)
  {
    my $path = '';
    my $code = '';

    # Split the line up into the modification code and path, ignoring
    # property modifications.
    if ($line =~ /^(.). (.*)$/)
      {
        $code = $1;
        $path = $2;
      }

    if ($code eq 'A')
      {
        push(@adds, $path);
      }
    elsif ($code eq 'D')
      {
        push(@dels, $path);
      }
    else
      {
        push(@mods, $path);
      }
  }

open DEBUG, ">>/tmp/commit-fixattribs.log";

for my $file (@adds, @mods) {
    next unless ($file =~ /\.(?:h|c|C|cpp|pl|pm|t|py)$/);

    print DEBUG "need to check: '$file'\n";

    my @propget = read_from_process($svnlook, 'propget', $repos, 'svn:keywords', $file);

    my %props;

    if (@propget && $propget[0] !~ /failed/) {
        for (@propget) {
            for (split) {
                $props{$_} = 1;
            }
        }
    }

    print DEBUG Dumper(\%props);

    my @props_to_add;

    for ('LastChangedDate', 'LastChangedRevision', 'LastChangedBy', 'HeadURL', 'Id') {
        push @props_to_add, $_ unless exists $props{$_};
    }

    # all the props there?
    next unless (@props_to_add);

    my $new_props = join(' ', keys %props, @props_to_add);

    print DEBUG "new props: '''$new_props'''\n";

    my $dir = tempdir( CLEANUP => 1 );

    print DEBUG "tempdir: $dir\n";

    my $file_dir;
    my $bare_file;

    if ($file =~ m|^(.*/)([^/]+)$|) {
        $file_dir = $1;
        $bare_file = $2;
    } else {
        $file_dir = '/';
        $bare_file = $file;
    }

    chdir $dir
        or die "Couldn't chdir to '$dir': $!";

    # checkout the file in question
    my @checkout = read_from_process($svn, 'checkout', '--non-interactive', '--config-dir', '/tmp', '--non-recursive', '--quiet', "$urlbase/$file_dir", '.');

    print DEBUG Dumper(\@checkout);

    next if (@checkout);

    # modify the props
    my @propset = read_from_process($svn, 'propset', '--non-interactive', '--config-dir', '/tmp', '--quiet', 'svn:keywords', $new_props, $bare_file);

    print DEBUG Dumper(\@propset);

    next if (@propset);

    # commit the change
    my @commit = read_from_process($svn, 'commit', '--non-interactive', '--config-dir', '/tmp', '--non-recursive', '--quiet', '--message', 'svn:keywords modified by commit-fixattribs.pl', $bare_file);

    print DEBUG Dumper(\@commit);
}

close DEBUG;

exit 0;

sub usage
{
    print "use me\n";
}

# Start a child process safely without using /bin/sh.
sub safe_read_from_pipe
{
  unless (@_)
    {
      croak "$0: safe_read_from_pipe passed no arguments.\n";
    }

  my $pid = open(SAFE_READ, '-|');
  unless (defined $pid)
    {
      die "$0: cannot fork: $!\n";
    }
  unless ($pid)
    {
      open(STDERR, ">&STDOUT")
        or die "$0: cannot dup STDOUT: $!\n";
      exec(@_)
        or die "$0: cannot exec `@_': $!\n";
    }
  my @output;
  while (<SAFE_READ>)
    {
      s/[\r\n]+$//;
      push(@output, $_);
    }
  close(SAFE_READ);
  my $result = $?;
  my $exit = $result >> 8;
  my $signal = $result & 127;
  my $cd = $result & 128 ? "with core dump" : "";
  if ($signal or $cd)
    {
      warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
    }
  if (wantarray)
    {
      return ($result, @output);
    }
  else
    {
      return $result;
    }
}

# Use safe_read_from_pipe to start a child process safely and return
# the output if it succeeded or an error message followed by the output
# if it failed.
sub read_from_process
{
  unless (@_)
    {
      croak "$0: read_from_process passed no arguments.\n";
    }
  my ($status, @output) = &safe_read_from_pipe(@_);
  if ($status)
    {
      return ("$0: `@_' failed with this output:", @output);
    }
  else
    {
      return @output;
    }
}

---------------------------------------------------------------------
To unsubscribe, e-mail: users-unsubscribe@subversion.tigris.org
For additional commands, e-mail: users-help@subversion.tigris.org
Received on Tue Oct 19 21:42:36 2004

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.