ckp_change_serverid.pl #1

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

  --help,-h         Print this help
  <output-file>     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