#!/usr/bin/perl -w
###############################################################################
#
# File:         SaveLabels.pl
#
# Parameters:   -l <label>
#               If no label is specified then all labels in the system are scanned and saved
#
# Purpose:      Saves text versions of all labels in a configurable place in the
#               repository.
#
# Author:       Robert Cowham (robert@vaccaperna.co.uk)
#
# History:      2001/02/16  First version
#               2001/03/06  Made OS switch (should work on NT or Unix)
#                           take depot path from client view
#
#
#   Expects there to exist a Perforce client client with the name specified in the
#   configuration section.
#
#   The client definition should be something like:
#
#      Client: depot_history_labels
#      Root:   c:\work\labels
#      View:
#           //depot/depot_history/labels/... //depot_history_labels/...
#
#   Note that it doesn't matter what the left hand side of the view looks like (as long as it
#   has a "/..." at the end. The right hand side should have nothing but the client name
#   (followed by "/...").
#
#   Not too surprisingly the root should be a temp directory with full read/write access.
#
#
###############################################################################

use strict;

# Command option parsing
use Getopt::Long;

use vars qw(
    $p4
    $label
    $verbose
    $config
    $depot_path
    $client_name
    $client_root
    %all_labels
    $os_separator
);

BEGIN {}

# ***********************
# Configuration - you might want to edit these two definitions for your depot.

# Define the name of the appropriate client to use (see above)
$client_name = "depot_history_labels";

# Define Perforce command (set appropriate path here, plus username/passwd if appropriate
$p4 = "p4 -c $client_name ";

# End of configuration
# ************************

$label = "";
$depot_path = "";

$os_separator = "/";    # valid for Unix ("\\" for NT)
$os_separator = "\\" if $^O =~ /MSWin32/i;

readParams ();
trace(2, "Operating system file separator '" . $os_separator. "'\n");
trace(1, "p4 info:\n" . `$p4 info`);

&checkClient();

&getClientInfo();
&listLabels();
if ($label ne "")
{
    &saveLabel($label);
}
else
{

    foreach $label (keys %all_labels)
    {
        &saveLabel($label);
    }

}

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]] [-l <specific label>]\n" .
                "If no label is specified then all labels in the system are scanned and saved\n";

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

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

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


    # Check for name of client
    if (@ARGV > 0)
    {
        die "Error: too many parameters specified!\n$usage";
    }

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

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

}

###############################################################################
#
# Function:     saveLabel
# Purpose:      Check the specified label to see if it has changed and if so save
#               in appropriate place in the depot.
#
###############################################################################
sub saveLabel ($) {
    my ($label) = @_;

    my $result;
    my $cmd;
    my $filename;
    my $depot_filename;

    # Translate invalid chars!!
    my $label_file = $label;
    $label_file =~ s#\/#:#;

    $depot_filename = "$depot_path$label_file.txt";
    $filename = "$client_root$os_separator$label_file.txt";

    # Check if label exists
    if (!defined($all_labels{$label}))
    {
        die "***** Error: label '$label' does not exist!";
    }

    # Dig out some info from the label
    $cmd = "$p4 label -o $label";
    my $l_contents = `$cmd`;

    my $description;
    my $view;

    trace(4, "Label output: $l_contents");

    ($description) = ($l_contents =~ m/\nDescription:\n(.*)\n\nOptions:/s);
    trace(3, "Label desc: $description\n");

    ($view) = ($l_contents =~ m/\nView:\n(.*)$/s);
    chomp $view;
    trace(3, "Label view: $view\n");


    # If file doesn't exist in Perforce then add it
    $cmd = "$p4 sync $depot_filename 2>&1";
    trace(3, "Check Cmd: $cmd\n");

    $result = `$cmd`;
    trace(3, "Results: $result\n");

    # Remove file so we can update it's contents
    unlink("$filename");

    # Save the contents of the label to the appropriately named file

    open(LAB, ">$filename") || die "can't open file $filename $! $?";
    print LAB <<_end_write;
Label:  $label

Description:
    $description

View:
    $view
_end_write

    close LAB || die "bad close: $! $?";

    $cmd = "$p4 files \@$label >> $filename";
    trace(3, "Cmd: $cmd\n");

    $result = `$cmd`;
    trace(3, "Results: $result\n");


    # If file doesn't exist in Perforce then add it
    $cmd = "$p4 fstat $depot_filename 2>&1";
    trace(3, "Check Cmd: $cmd\n");

    $result = `$cmd`;
    trace(3, "Results: $result\n");

    # Look for something that is there if the file exists in the depot
    if ($result =~ /headRev/s)
    {
        # Edit new file
        trace(3, "Editing file\n");

        # If file doesn't exist in Perforce then add it
        $cmd = "$p4 diff -se $depot_filename";
        trace(3, "Check Cmd: $cmd\n");

        $result = `$cmd`;
        trace(3, "Results: $result\n");

        # Look for anything as an indicator the file differs from the depot version
        if ($result !~ /^\s*$/)
        {
            # Edit and submit the changed file.
            $cmd = "$p4 edit $depot_filename";
            trace(3, "Cmd: $cmd\n");
            $result = `$cmd`;
            trace(3, "Results: $result\n");

            &doSubmit($depot_filename, "Automatic update of label contents in depot history.");

            print "Label '$label' has been updated in the depot history.\n";
        }

    }
    else
    {
        # Add new file
        trace(3, "Adding file\n");

        # Make the file writeable - it's easier to diff
        $cmd = "$p4 add -t text+w $depot_filename";
        trace(3, "Cmd: $cmd\n");
        $result = `$cmd`;
        trace(3, "Results: $result\n");

        &doSubmit($depot_filename, "Automatic addition of new label to depot history.");

        print "Label '$label' has been added to the depot history.\n";

    }




}


###############################################################################
#
# Function:     doSubmit
# Purpose:      Make Perforce submit
#
###############################################################################

sub doSubmit()
{
    my ($depot_filename, $description) = @_;

    my $cmd;

    $cmd = "| $p4 submit -i ";
    trace(3, "Command: $cmd\n");
    open(CMD, $cmd) || die "can't fork: $!";
    print CMD <<_end_of_submit;

Change: new

Client: $client_name

Status: new

Description:
    $description

Files:
    $depot_filename
_end_of_submit

    close CMD || die "bad write: $! $?";

}

###############################################################################
#
# Function:     getClientInfo
# Purpose:      Get root directory of our client
#
###############################################################################

sub getClientInfo()
{
    my $cmd = "$p4 client -o $client_name";
    my $c_contents = `$cmd`;

    my $view;

    trace(4, "Client output: $c_contents");

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

    ($client_root) = ($c_contents =~ m/\nRoot:\s+([^\n]*)\n/s);
    trace(3, "Client Root: $client_root\n");

    ($view) = ($c_contents =~ m/\nView:\n\s+(\S*)/s);
    trace(3, "Client view: $view\n");

    $view =~ s/\.\.\.//;    # remove extra bit
    trace(3, "Client view: $view\n");

    $depot_path = $view;
}

###############################################################################
#
# Function:     listLabels
# Purpose:      List all labels in the depot and put in a global hash.
#
###############################################################################

sub listLabels()
{

    my @result = `$p4 labels`;

    my ($line, $label);

    foreach $line (@result)
    {
        if ($line !~ /^\s*$/)
        {
            trace(4, "LabelLine: $line");
            ($label) = ($line =~ /^Label\s+(\S+)/);

            trace(4, "label: $label\n\n");
            if (defined($label))
            {
                $all_labels{$label} = $label;
            }
            else
            {
                die "Error processing labels!!";
            }
        }
    }

}

###############################################################################
#
# Function:     checkClient
# Purpose:      Checks that global client exists
#
###############################################################################

sub checkClient()
{

    my @result = `$p4 clients`;

    my ($line, $c, %all_clients);

    foreach $line (@result)
    {
        if ($line !~ /^\s*$/)
        {
            ($c) = ($line =~ /^Client\s+(\S+)/);

            trace(4, "client: $c\n\n");
            if (defined($c))
            {
                $all_clients{$c} = $c;
            }
            else
            {
                die "Error processing clients!!";
            }
        }
    }

    if (!defined($all_clients{$client_name}))
    {
        die "**** Couldn't find perforce client '$client_name'!!\n";
    }

}


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

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

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