#!/usr/bin/perl

# -----------------------------------------------------------------------------
# Copyright (c) 2012, Perforce Software, Inc.  All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# 
# 1.  Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
# 
# 2.  Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE SOFTWARE, INC. BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# -----------------------------------------------------------------------------

use strict;
use warnings;
use P4;
use Data::Dumper;


# --- Usage -------------------------------------------------------------------
# triggers:
#	filter form-out client "/usr/bin/perl /p4/1/bin/triggers/client_filter.pl
#		%user% %formname% %formfile%"


# --- Verbose level -----------------------------------------------------------
#  0 - normal operation
#  1 - debug data
my $verbose = 0;


# --- Server connection details -----------------------------------------------
my %info = 	(	'p4port' 	=> 	'localhost:1666', 
				'p4user' 	=>	'trigger',
				'p4passwd'	=>	'P3rforce',
				'p4charset' =>  'none' );


# --- Globals -----------------------------------------------------------------				
our $user = shift;			# arg[0]
our $client = shift;		# arg[1]
our $formfile = shift;		# arg[2]
our $comment;

# Set minimum access level to create a view
our $min_acl = 'open';




# -----------------------------------------------------------------------------
# MAIN Function: 	client_filter
# Description: 		Filter client 'View' field based on 'p4 protects' 
# -----------------------------------------------------------------------------

## Connect and Fetch client spec
my $p4 = p4_connect( \%info );
my $spec = fetch_client( $formfile );

## Exit if client already exists
if( $spec->{Access} ) {
	dprint( 1, "exiting: client exists\n");
	exit 0;
}

## update form with new view
$spec->{View} = build_view( $user, to_acl($min_acl) );
my $out = $p4->FormatClient( $spec );

## update tmp spec file
open( FILE, ">", $formfile ) or die $!;

my $notice = <<EOF;
# The view in this client spec has been generated by form-out trigger
# with a minimum permission level of '$min_acl'.  Please note that there
# may be duplicate or redundant View that must be removed. For example:
# 
# View:
#     //depot/proj/MAIN/...  //myClient/depot/proj/MAIN/...
#     //depot/proj/...       //myClient/depot/proj/...
#
EOF

print FILE $notice . $comment . $out;
exit 0;			




# -----------------------------------------------------------------------------
# Function name: 	fetch_client( formfile )
# Description: 		returns spec and updates global comment 
# -----------------------------------------------------------------------------
sub fetch_client {
	my $file = shift;
	my $in_str;
	
	## Grab client spec
	open( IN, "<", $file ) or die $!;
	
	while (<IN>) {
		## seperate comment from fields
		if( $_ =~ /^#.*/ ) {
			$comment .= $_;
		} else {
			$in_str .= $_;
		}
	}
	my $spec = $p4->ParseClient( $in_str );
	close( IN );
	
	return $spec;
}

# -----------------------------------------------------------------------------
# Function name: 	build_view( user, min_acl )
# Description: 		returns view
# -----------------------------------------------------------------------------
sub build_view {
	my $user = shift;
	my $min = shift;
	
	## Get users permissions
	my @protect = $p4->RunProtects( "-u", $user );

	## Build view list of accessible depot paths
	my @view;
	foreach my $p (@protect) {
		
		## skip exclusion mappings
		if( !exists $p->{unmap} ) {
			
			## check acl level
			my $perm = $p->{perm};
			if( to_acl($perm) >= $min ) {
				
				my $dpath = $p->{depotFile};
				dprint( 1, "perm: $dpath ($perm)\n");
				
				## exit, if view for multi depots
				if( $dpath =~ /\/\/\.\.\./ ) {
					dprint( 1, "exiting: found global protection '//...'\n");
					exit 0;
				}
				
				## add new view to map 
				if( $dpath =~ /\/\/(.*)/ ) {
					my $cpath = $1;
					my $v = "$dpath //$client/$cpath";
					push( @view, $v );
					dprint( 1, "view: $v\n");
				}
			}
		}
	}
	
	## Remove identical lines
	@view = uniq( @view );
	
	return \@view;
}

# -----------------------------------------------------------------------------
# Function name: 	uniq( views )
# Description: 		return unique list of views
# -----------------------------------------------------------------------------
sub uniq {
    return keys %{{ map { $_ => 1 } @_ }};
}

# -----------------------------------------------------------------------------
# Function name: 	to_acl( string )
# Description: 		return integer value for cal
# -----------------------------------------------------------------------------
sub to_acl {
	my $perm = shift;
	
	my %acl = 	(	'list' 		=> 	1, 
					'read' 		=>	2,
					'open'		=>	3,
					'write' 	=>  4,
					'branch'	=>	5,
					'admin'		=>	6,
					'super'		=>	7 	);
				
	## remove '=' from perm
	$perm =~ s/=//;
	my $val = $acl{ $perm };
	dprint( 2, "to_acl: $perm => $val\n" );
	return $val;
}
		
# -----------------------------------------------------------------------------
# Function name: 	p4_connect( info )
# Description: 		Connection helper, takes info as hash
# -----------------------------------------------------------------------------
sub p4_connect {
	my $info = shift;
	
	my $p4 = new P4;
	$p4->Debug($verbose);
	$p4->SetPort( $info->{'p4port'} );
	$p4->SetUser( $info->{'p4user'} );
	$p4->SetPassword( $info->{'p4passwd'} );
	if( $info->{'p4charset'} ne 'none' ) {
		$p4->SetCharset( $info->{'p4charset'} );
	}
	
	$p4->Connect() or die("Failed to connect to Server " . $info->{'p4port'} );
	dprint( 1, "Connected to Server: " . $p4->GetPort() . "\n" );
	$p4->RunLogin();
	
	return $p4;
}


# -----------------------------------------------------------------------------
# Function name: 	dprint( level, 'string' )
# Description: 		Print out debug messages at verbose level
# -----------------------------------------------------------------------------
sub dprint
{
	my $level = shift;
	my $pad = "... ";
	$pad x= $level;
	my $str = shift;
	
	if( $verbose >= $level ) {
		print( $pad . $str );
	}
}