#!/usr/bin/env perl

# ====================================================================
# A modified version of the sample SVN Hook Scripts.
# 
# This script will prevent SVN users from checking into a tag.
# A "tag" is considered to be under the "tags" folder and not
# under the "branches" or "trunk" folder.
#
# Version: 1.0.0
# Date: 2008-03-03, Time: 10:12 am
# Author: Andres Galeano
# ====================================================================


# ====================================================================
# commit-access-control.pl: check if the user that submitted the
# transaction TXN-NAME has the appropriate rights to perform the
# commit in repository REPOS using the permissions listed in the
# configuration file CONF_FILE.
#
# $HeadURL$
# $LastChangedDate$
# $LastChangedBy$
# $LastChangedRevision$
#
# Usage: commit-access-control.pl REPOS TXN-NAME CONF_FILE
#    
# ====================================================================
# 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/.
# ====================================================================

# Turn on warnings the best way depending on the Perl version.
BEGIN {
  if ( $] >= 5.006_000)
    { require warnings; import warnings; }                      
  else  
    { $^W = 1; }               
}           

use strict;
use Carp;

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

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

# Since the path to svnlook depends upon the local installation
# preferences, check that the required program exists to insure that
# the administrator has set up the script properly.
{
  my $ok = 1;
  foreach my $program ($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.

&usage unless @ARGV >= 2;

my $repos        = shift;
my $txn          = shift;

unless (-e $repos)
  {
    &usage("$0: repository directory `$repos' does not exist.");
  }
unless (-d $repos)
  {
    &usage("$0: repository 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 directories have changed using svnlook..
my @dirs_changed = &read_from_process($svnlook, 'dirs-changed', $repos,
                                      '-t', $txn);

# Lose the trailing slash in the directory names if one exists, except
# in the case of '/'.
my $rootchanged = 0;
for (my $i=0; $i<@dirs_changed; ++$i)
  {
    if ($dirs_changed[$i] eq '/')
      {
        $rootchanged = 1;
      }
    else
      {
        $dirs_changed[$i] =~ s#^(.+)[/\\]$#$1#;
      }
  }

# Figure out what files have changed using svnlook.
my @files_changed;
foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t', $txn))
  {
    # Split the line up into the modification code and path, ignoring
    # property modifications.
    if ($line =~ /^..  (.*)$/)
      {
        push(@files_changed, $1);
      }
  }

# Create the list of all modified paths.
my @changed = (@dirs_changed, @files_changed);

# There should always be at least one changed path.  If there are
# none, then there maybe something fishy going on, so just exit now
# indicating that the commit should not proceed.
unless (@changed)
  {
    die "$0: no changed paths found in txn `$txn'.\n";
  }

######################################################################
# Go through all the modified paths
my @failed_paths;

# Check svn look and repository
`$svnlook info $repos`;
# Make sure we can use svnlook and reach the repository.
if ($? != 0) {
    warn "$0: Can not get repository info. ", "This path:\n  ", $repos, "\n"; 
    exit 1;
}

  foreach my $path (@changed)
  {

        my $current_path="";
        my @components = (split(/\//,$path));
        for(my $i=0;$i<((@components)-1);$i++) {

                my $component = $components[$i];
                $current_path .= "$component/";
                if ($component =~ /^(trunk|branches)$/i) {
                        last;
                } elsif ($component =~ /^tags$/i) {
                        my $tagName = $current_path . $components[$i+1] . "\n";

			`$svnlook history $repos $tagName`;
                        # push(@failed_paths, $svnlook . ' ' . 'history' . ' ' . $repos . ' ' . $tagName . ' == ' . ' ' . $?);

                        # if tag has history, (svnlook succeeds), do not allow commit
                        if($? == 0) {
                          push(@failed_paths, $path);
                        }
                        last;
                }
        }

  }


if (@failed_paths)
  {
    warn "$0: Can not commit to a tag. ",
         @failed_paths > 1 ? "These paths:\n  " : "This path:\n  ",
         join("\n  ", @failed_paths), "\n"; 
    exit 1;
  }
else
  {
    exit 0;
  }

sub usage
{
  warn "@_\n" if @_;
  die "usage: $0 REPOS TXN-NAME\n";
}

sub safe_read_from_pipe
{
  unless (@_)
    {
      croak "$0: safe_read_from_pipe passed no arguments.\n";
    }
  print "Running @_\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>)
    {
      chomp;
      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;
    }
}

sub read_from_process
  {
  unless (@_)
    {
      croak "$0: read_from_process passed no arguments.\n";
    }
  my ($status, @output) = &safe_read_from_pipe(@_);
  if ($status)
    {
      if (@output)
        {
          die "$0: `@_' failed with this output:\n", join("\n", @output), "\n";
        }
      else
        {
          die "$0: `@_' failed with no output.\n";
        }
    }
  else
    {
      return @output;
    }
}