#! /usr/bin/perl
# Script to force the end-user to answer 'yes' or 'no' before they can
# submit a changelist.
# Copyright (c) 2009, 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.
# User contributed content on the Perforce Public Depot is not supported by
# Perforce, although it may be supported by its author. This applies to all
# contributions even those submitted by Perforce employees.
# turn off output buffering.
$| = 1;
# this example uses P4Perl since it makes form-parsing easy. but if you didn't
# want to do that, you could easily cook up hard-coded change-form text to
# emit along with the customizations.
#
# http://perforce.com/perforce/loadsupp.html#api
use P4;
my $p4 = new P4;
# Triggers:
# changeform-yesno form-out change "/path/to/submit-yesno.pl form-out %formtype% %formfile%"
# submit-yesno change-submit //... "/path/to/submit-yesno.pl change-submit %change%"
# print "ARGV: @ARGV\n";
# note that STDOUT goes back to the user, so if you print any here and the user
# redirects "p4 change -o" to a file, it'll end up there and probably be an
# invalid form unless you put whatever you're printing in the description field.
#
# the "die" call prints to STDERR, which only shows up on the server console
# (not sent to the end-user. a proper script would not do this, but instead log
# to a file.
if( @ARGV < 2 )
{
die "wrong number of arguments - expected at least 2\n";
}
$form_question = "Did you mean to submit this changelist";
$form_choice = "$form_question: YES/NO";
$form_header = qq[
Enter change description below:
-------------------------------
];
# hard-coded type argument so this program knows how to behave.
$trig_type = shift @ARGV;
if( $trig_type eq "form-out" )
{
if( @ARGV < 2 )
{
die "you've still got the wrong number of arguments\n";
}
$form_type = shift @ARGV;
if( $form_type ne "change" )
{
die "wrong form type - expected 'change'\n";
}
# %formfile% should always be the last argument, since if it's a path
# with spaces, you won't get it all with a single ARGV element.
$form_file = "@ARGV";
open( FORM, "<$form_file" ) or
die "trigger couldn't open form_file '$form_file': $!\n";
while( $_ = <FORM> )
{
$form_content .= $_;
}
close FORM;
$form_hash = $p4->ParseChange( $form_content );
# don't mess with people's pending, numbered changelist updates
if( $$form_hash{ "Change" } ne "new" )
{
exit 0;
}
$$form_hash{ 'Description' } = "$form_choice\n$form_header\n";
# truncate and re-open for writing.
open( FORM, ">$form_file" ) or
die "trigger couldn't open form_file '$form_file': $!\n";
# for some reason the form comments are being dropped here.
# they're usually not that useful anyways, and you only see
# them via the CLI.
print FORM $p4->FormatChange( $form_hash );
close FORM;
exit 0;
}
if( $trig_type eq "change-submit" )
{
if( @ARGV != 1 )
{
die "you've still got the wrong number of arguments\n";
}
$change_num = shift @ARGV;
if( $change_num !~ /\d+/ )
{
die "just what are you trying to do here? $change_num\n";
}
&p4_connect;
$change_hash = $p4->FetchChange( $change_num);
$full_desc = $$change_hash{ "Description" };
$full_desc =~ /^$form_question:\s*(\S+)\s*/;
$user_answer = $1;
unless ( lc $user_answer eq "yes" )
{
print "\n\ntrigger says: you are indecisive\n";
exit 1;
}
# leave just the user's real description. if the form header exists
# as part of the real changelist description, this might remove any
# text in between.
$full_desc =~ s/$form_question:.*$form_header//s;
$$change_hash{ 'Description' } = $full_desc;
$p4->SaveChange( $change_hash );
&p4_disconnect;
exit 0;
}
die "error, unknown type!";
exit 1;
sub p4_connect
{
# user must be super in order to update other users' changelist descriptions
$p4->SetUser( "" );
$p4->SetPassword( "" );
$p4->SetPort( "localhost:4444" );
# shows up in the server log file
$p4->SetProg( "example change description trigger" );
$p4->SetVersion( "1" );
$p4->Connect() or die( "Failed to connect to Perforce Server.\n" );
}
sub p4_disconnect
{
print "\ntrigger errors :\n\n" . $p4->Errors() . "\n" if $p4->Errors();
print "\trigger warnings:\n\n" . $p4->Warnings() . "\n" if $p4->Warnings();
$p4->Disconnect();
}