#! /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();
}