#!/usr/bin/perl -w # Copyright (c) 2007, 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. # # See PerlDoc in footer of script use POSIX qw( strftime ); use Time::Local; package ckp_change_serverid; use P4::Journal; my %changelists = (); my $processed_count = 0; our @ISA = qw( P4::Journal ); sub new( $$ ) { my $class = shift; my $output = shift; my $i; my $self = new P4::Journal; bless( $self, $class ); open OUTPUT, ">$output" or die "Could not write to \'" . $output . "\':\n" . $!; return $self; } sub ParseRecord( $ ) { my $self = shift; my $rec = shift; my $op; my $jver; my $dbName; my $remainder; my $updated = 0; if ( $rec->Raw() ) { ($op, $jver, $dbName, $remainder) = split " ", $rec->Raw(), 4; SWITCH: { if( !defined $dbName ) { last SWITCH; } if( !defined $rec->Raw() ) { last SWITCH; } if( $dbName eq "\@db.domain@" ) { my $val = $rec->FetchField( 'serverid' ); if( defined($val) && $val eq 'chongqing_edge' ) { $updated = 1; $processed_count++; $rec->SetField( 'serverid', 'p4d_edge_nanjing' ); } last SWITCH; } } } # Only print output updated fields if ( $updated ) { printf OUTPUT "%s\n", $rec->Raw(); } } sub DESTROY { close OUTPUT; } package main; use Getopt::Long 'HelpMessage'; GetOptions( 'changes_file=s' => \(my $changes_file=""), 'help' => sub { HelpMessage(0) }, ) or HelpMessage(1); my $output = shift; if (!defined $output) { die "You must supply an output file name.\n"; } my $ckp = new ckp_change_serverid( $output ); $ckp->Parse; printf STDERR "db.domain records updated: %d\n", $processed_count; =head1 NAME ckp_change_serverid - change serverid field in db.domain for edge servers =head1 SYNOPSIS ckp_change_serverid.pl --help,-h Print this help Specify output file (or '-' for stdout) Prints out matching records for specified workspaces from db.domain The output is a journal format which can be edited to change @pv@ to @dv@ and then applied. The P4::Journal module must be installed as this script heavily uses that module. Be careful about running this script on large checkpoints - may take a while! Examples: Process checkpoint and save the results to an uncompressed journal: cat domain.ckp | ckp_change_serverid.pl jnl.changes Same thing but with compressed checkpoint and resulting journal: cat domain.ckp.gz | gunzip | ckp_change_serverid.pl - | gzip > jnl.domain.gz =cut