CreateClient.pl #1

#!perl -w
###############################################################################
#
# File:         CreateClient.pl
# Syntax:       perl CreateClient.pl
# Parameter:    -t <template> <client name>
# Purpose:      Create a client from the specified template and make sure that
#               all options are copied with the client.
# Author:       Robert Cowham (robert@vaccaperna.co.uk)
# History:      24/11/2000  created the first version
#               30/11/2000  Copy root and description fields into new client.
#
###############################################################################

use strict;

# Command option parsing
use Getopt::Long;

use vars qw(
	$p4
    $release
    $date
    $template
    $client
    $verbose
);

BEGIN {}

$p4 = "p4";

readParams ();
&createClient($template, $client);

exit(0);


###############################################################################
# ONLY SUBROUTINES BELOW !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
###############################################################################

###############################################################################
#
# Function:     readParams
# Purpose:      Read the parameters from the command line and initialize all vars
#
###############################################################################
sub readParams {

    my $usage = "Usage: $0 [-v [verbose level]] -t <template client> <client>\n";

    my $result;
    $verbose = -1;  # default - will be set to zero if specified with no parameter

    $result = GetOptions("t=s" => \$template,
                         "v:i" => \$verbose
                         );

    if (!$result)
    {
        die "Error: Invalid parameters!\n$usage";
    }

    if (!defined($template) || $template eq "")
    {
        die "Error: Template must be specified!\n$usage";
    }

    # Check for name of client
    if (@ARGV > 1)
    {
        die "Error: too many parameters specified!\n$usage";
    }
    elsif (@ARGV < 1)
    {
        die "Error: No client file specifed!\n$usage";
    }
    else
    {
        $client = $ARGV[0];
    }

    $verbose = 1 if ($verbose == 0);

    trace(1, "Params: template=$template, client=$client, verbose=$verbose\n");

}

###############################################################################
#
# Function:     createClient
# Purpose:      Call the appropriate commands to create the client, and modify the
#               various fields within it.
#
###############################################################################
sub createClient ($$) {
    my ($template, $client) = @_;


    my $cmd = "$p4 client -o -t $template $client";
    my $c_contents = `$cmd`;

    trace(3, "Results: $c_contents");

    # Check for template not existing
    if (!defined($c_contents) || $c_contents eq "")
    {
        die "Error!";
    }

    # OK, now we get the contents of the template command
    $cmd = "$p4 client -o $template";
    my $t_contents = `$cmd`;

    trace(3, "Template contents: $t_contents\n");

    # parse the output for views for options and root directory - we ignore line endings
    my ($options) = ($t_contents =~ m/\nOptions:\s+([^\n]*)\n/s);
    trace(2, "Options: $options\n");

    my ($root) = ($t_contents =~ m/\nRoot:\s+([^\n]*)\n/s);
    trace(2, "Root: $root\n");

    # Update the contents of the client
    $c_contents =~ s/\nOptions:\s+[^\n]*\n/\nOptions:  $options\n/m;
    trace(3, "New contents: $c_contents\n");

    # Update the root directory too
    $c_contents =~ s/\nRoot:\s+[^\n]*\n/\nRoot:  $root\n/m;

    # Extract out some other fields
    my ($desc) = ($t_contents =~ m/\nDescription:\n(.*)\nRoot:/s);
    trace(2, "Description:\n$desc\n");
    $c_contents =~ s/\nDescription:\n.*\nRoot:/\nDescription:\n$desc\nRoot:/s;

    trace(3, "New contents: $c_contents\n");

    # Finally write out the contents of the new client and save to Perforce
    $cmd = "| $p4 client -i ";
    trace(3, "Command: $cmd\n");
    open(CLIENT, $cmd) || die "can't fork: $!";
    print CLIENT "$c_contents\n";
    close CLIENT || die "bad write: $! $?";

}



###############################################################################
#
# Function:     trace
# Purpose:      Output trace information
#
###############################################################################
sub trace {
	    my ($level, $msg) = @_;

	    if ($verbose >= $level) {
	            print STDOUT $msg;
	    }
}

###############################################################################
# END OF FILE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
###############################################################################