#!/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
###############################################################################