#!/usr/bin/env perl # #******************************************************************************* # #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. #******************************************************************************* #Author: Stephen Moon #Date: June 18, 2010 #Summary: This is the same as getRecordLabel.pl, but it does not # require a label name file. # # This will rename the depots of all these labels with the new # specified depot name. #******************************************************************************* use warnings; use strict; use Fatal qw/ open /; use warnings; use strict; use Fatal qw/ open /; my $debug = 1; #$debug = 1 turns on debugging my $argc = @ARGV; my $opcode = ""; if ($argc != 3) { die "Usage: renameLabelDepot.pl \n" . "e.g. getRecordForLabel.pl chkpt labelNames.txt depot2\n"; } my $odepot = $ARGV[1]; my $ndepot = $ARGV[2]; my $labelHashRef = {}; open(INCHKPT,"$ARGV[0]"); open(OUTCHKPT,">$ARGV[0].new"); $labelHashRef = &extractLabelNames($ARGV[0],$labelHashRef); while() { if(/^\@pv\@ \d+ (\@db.view\@|\@db.label\@) .*$/) { $opcode = $_; $opcode = &processLabels(\$opcode,$labelHashRef,\$odepot,\$ndepot); $_ = $opcode . "\n"; } print OUTCHKPT "$_"; } close(INCHKPT); close(OUTCHKPT); sub processLabels() { my $opcodeRef = shift; my $labelHashRef = shift; my $odepotRef = shift; my $ndepotRef = shift; if($debug == 1) { print "Before Opcode Process: $$opcodeRef, $$odepotRef, $$ndepotRef \n"; foreach (keys %$labelHashRef) { print "DEBUG: $_\n"; } } foreach my $eachLabel (keys %$labelHashRef) { #print "label: $eachLabel\n"; chomp; if($$opcodeRef =~ /^\@pv\@ \d+ (\@db.view\@|\@db.label\@) \@$eachLabel\@ .*$/) { if($debug == 1) { print "Process opcode for each label: \n" . "$$opcodeRef, $$odepotRef, $$ndepotRef\n"; } $opcodeRef = &replaceDepot($opcodeRef,$odepotRef,$ndepotRef); } } return $$opcodeRef; } sub extractLabelNames() { my $chkptName = shift; my $labelHashRef = shift; open(IN,"$chkptName"); while() { if(/^\@pv\@ \d+ \@db.label\@ \@(\S+)\@.*$/) { if(!defined($labelHashRef->{$1})) { $labelHashRef->{$1} = 1; } else { $labelHashRef->{$1}++; } } } close(IN); return $labelHashRef; } sub replaceDepot() { my $opcodeRef = shift; my $odepotRef = shift; my $ndepotRef = shift; $$opcodeRef =~ s#//$$odepotRef/#//$$ndepotRef/#g; if($debug == 1) { print "After fix: $$opcodeRef\n"; } return $opcodeRef; }