#!/usr/bin/perl -w
#
# PVCS to Perforce converter, phase III: construct Perforce depot
#
# Copyright 1997 Perforce Software. All rights reserved.
# Written by James Strickland, July 1997
# Modified by Robert Cowham, 2000 onwards.
#
# This script uses the metadata produced by earlier phases to direct a loop
# which extracts PVCS revisions and performs the required Perforce commands
# to construct a Perforce depot corresponding to the (improved) PVCS data.
#
require 5.0;
use strict;
use integer;
use lib '.';
use convert;
use Change;
use File::Path;
use File::Spec;
# open all our input files
my $msg="can't open for read";
open(FILES, "<$convert::metadata_dir/files") or die $msg;
open(LABELS, "<$convert::metadata_dir/labels_details") or die $msg;
open(LABELS_SUMMARY, "<$convert::metadata_dir/labels_summary") or die $msg;
open(CHANGES, "<$convert::metadata_dir/changes") or die $msg;
open(BRANCHES,"<$convert::metadata_dir/branches") or die $msg;
open(MAPPING, ">$convert::metadata_dir/mapping.ns") or die "can't open for write: $!";
# variables to be initialized with metadata read from files
my (%workfile, # maps archive -> workfile
# e.g. "c:\foo.c__v" -> "foo.c"
%file_type, # maps archive -> file type
# e.g. "c:\foo.c__v" -> "ktext"
%labels, # maps archive#revision -> list of labels
# e.g. "c:\foo.c_v#1.1" -> "itworks","bobsyouruncle"
%branches, # maps archive#revision -> list of branches
# e.g. "c:\foo.c_v#1.1" -> "int#1.1.1","testing#1.1.2"
%branch, # maps archive#branch_rev -> branch name
# e.g. "c:\foo.c_v#1.1.2" -> "testing"
%added, # maps depot file -> true/false
# e.g. "//depot/foo.c" -> 1
);
# Check for DB_File module installed - much faster for larger repositories if so
my $USEDB_FILE = 0;
#eval{use DB_File;};
#if (!$@) {
# $USEDB_FILE = 1;
# print "Using module DB_File\n";
# tie %workfile, "DB_File", "$convert::metadata_dir/db.workfile", O_RDWR|O_CREAT, 0666, $DB_HASH
# or die "Cannot open file '$convert::metadata_dir/db.workfile': $!\n";
# tie %file_type, "DB_File", "$convert::metadata_dir/db.file_type", O_RDWR|O_CREAT, 0666, $DB_HASH
# or die "Cannot open file '$convert::metadata_dir/db.file_type': $!\n";
# tie %labels, "DB_File", "$convert::metadata_dir/db.labels", O_RDWR|O_CREAT, 0666, $DB_HASH
# or die "Cannot open file '$convert::metadata_dir/db.labels': $!\n";
# tie %branches, "DB_File", "$convert::metadata_dir/db.branches", O_RDWR|O_CREAT, 0666, $DB_HASH
# or die "Cannot open file '$convert::metadata_dir/db.branches': $!\n";
# tie %branch, "DB_File", "$convert::metadata_dir/db.branch", O_RDWR|O_CREAT, 0666, $DB_HASH
# or die "Cannot open file '$convert::metadata_dir/db.branch': $!\n";
# tie %added, "DB_File", "$convert::metadata_dir/db.added", O_RDWR|O_CREAT, 0666, $DB_HASH
# or die "Cannot open file '$convert::metadata_dir/db.added': $!\n";
#}
# Check for P4 module installed
my $USEP4 = 0;
my $p4;
my $p4form;
eval{use P4;};
if (!$@) {
$USEP4 = 1;
print "Using P4Perl interface module\n";
$p4 = new P4;
$p4->SetPort($convert::p4port);
$p4->SetClient($convert::p4client);
$p4->SetUser($convert::p4user);
$p4->Init() or die( "Failed to connect to Perforce Server: $convert::p4port $!\n" );
$p4form = new P4;
$p4form->SetPort($convert::p4port);
$p4form->SetClient($convert::p4client);
$p4form->SetUser($convert::p4user);
$p4form->ParseForms();
$p4form->Init() or die( "Failed to connect to Perforce Server: $convert::p4port $!\n" );
}
# initialize %workfile and %file_type
while(<FILES>) {
chomp;
my ($archive,$workfile,$file_type) = split(/#/,$_);
$workfile{$archive}=$workfile;
$file_type{$archive}=$file_type;
}
close(FILES);
# initialize %labels
while(<LABELS>) {
chomp;
my ($label,$archive,$revision) = split(/#/,$_);
# Prefix label if specified
$label = $convert::label_prefix . $label;
my $index = join('#',$archive,$revision);
push @{$labels{$index}}, $label
}
close(LABELS);
# initialize %label and run p4 label once for each label which is not a
# "delete" label
my %labels_list;
while(<LABELS_SUMMARY>) {
chomp;
my ($label) = $_;
# Prefix label if specified
$label = $convert::label_prefix . $label;
next if($labels_list{$label});
if ($convert::delete_label_regex) {
next if ($label =~ /^$convert::label_prefix$convert::delete_label_regex/);
}
# Update the Description field in the label.
# Create a more specific view for the label - not just all depots which is the default.
my $comment = "pvcstop4 label"; # Set default comment.
my $label_view = "//$convert::depot/$convert::depot_root/...";
if (!$USEP4) {
my $form=convert::p4run(" label -o $label"); # label names cannot contain spaces
$form =~ s@(\nDescription:\s*)\n\s+\S[^\n]*\n@$1\n\t$comment@s;
$form =~ s@(\nView:\s*)\n\s+.*\n$@$1\n\t$label_view@s;
convert::p4run(" label -i",$form);
}
else {
my ($form, @view, @result);
$form = $p4form->FetchLabel($label);
$form->{'Description'} = $comment;
push @view, $label_view;
$form->{'View'} = \@view;
@result = $p4form->SaveLabel($form);
convert::log("Label update:\n".join("\n", @result));
print_p4errors($p4form, "Updating label $label");
}
$labels_list{$label}=1;
}
close(LABELS_SUMMARY);
# initialize %branches
# NOTE: PVCS (and RCS) do not allow revisions which are branch points to
# be deleted, so using a branch point as a trigger for creating branch copies
# is guaranteed to work.
while(<BRANCHES>) {
chomp;
my ($archive,$revision,$remainder) = split(/#/,$_,3);
$branches{join('#',$archive,$revision)} = $remainder;
}
close(BRANCHES);
# print timestamp
print "Depot creation started " . scalar(localtime()) . "\n";
# OK, now we do the actual work.
# For each change, there may or may not have to be
# - revisions retrieved from PVCS using 'get'
# - files marked as added or edited with 'p4 add' or 'p4 edit',
# followed by 'p4 submit'
# - files marked as being branched with 'p4 integrate' followed
# by 'p4 submit'
# - files marked as deleted with 'p4 delete' followed by 'p4 submit'
# - labels updated with 'p4 labelsync'
#
# Read below for the details..
my ($c,$op);
while( $c = get Change(\*CHANGES) ) {
my ($change_number,@checkins,@delete_ops,@label_ops,@branch_ops);
# PVCS operations are written to a file and one get operation is performed
# for performance reasons *and* to avoid overflowing the 127 character
# limit on DOS command lines. (We avoid that with the p4 ops because we
# keep them one per line with no repeated filenames).
open(PVCS_FILELIST,">filelist") or die "can't open filelist: $!";
my $index;
foreach $index (@{$c->changelist}) {
my ($archive,$revision) = split(/#/,$index);
my $our_branch = branch($archive,$revision);
my $client_rel_dir = convert::rel_dir( $archive,$our_branch);
# needed to ensure the directory exists to hold the workfile
my $client_dir = convert::join_paths( $convert::client_root,
$client_rel_dir );
# needed to tell PVCS where to put the workfile
my $client_file = convert::join_paths( $client_dir,
$workfile{$archive} );
# for p4 - could use $client_file, but I'd rather make sure we use
# the same string that's written out to the mapping file
my $depot_file = convert::join_paths( "//$convert::depot",
$client_rel_dir,
$workfile{$archive} );
# create all needed directories on the path
mkpath($client_dir);
# check to see if this is a branch point
if( exists($branches{$index}) ) {
# parse the list of branches
my $remaining=$branches{$index};
while($remaining) {
my ($branch_name,$branch_rev);
($branch_name,$branch_rev,$remaining) = split(/#/,$remaining,3);
$branch{join('#',$archive,$branch_rev)} = $branch_name;
my $branched_file = convert::join_paths( "//$convert::depot",
convert::rel_dir($archive,$branch_name),
$workfile{$archive} );
push(@branch_ops,"$depot_file#$branched_file");
$added{$branched_file}=1;
}
}
# schedule p4 add or edit operation
# depending on whether file has already been added
push(@checkins, [ $archive,$revision,$depot_file ] );
my $operation;
my $rev;
if($added{$depot_file}) {
p4exec($depot_file, "edit") =~ /#(\d+) - opened for edit/ or die "p4 edit $depot_file failed";
$rev = $1 + 1;
} else {
my @addcmd = ("add", "-t", "$file_type{$archive}");
p4exec($depot_file, @addcmd) =~ /opened for add/ or die "p4 add $depot_file failed";
$rev = 1;
$added{$depot_file}=1;
}
# check if this revision is labelled
if(exists($labels{$index})) {
for (@{$labels{$index}}) {
if($convert::delete_label_regex &&
$_ =~ /^$convert::label_prefix$convert::delete_label_regex/) { # marked for deletion
$added{$depot_file}=0;
push(@delete_ops, "$depot_file");
} else {
open(LABEL, ">>$convert::metadata_dir/labels/$_") or die $msg;
print LABEL "$depot_file#$rev\n";
close LABEL;
}
}
}
# add the file to the list of files for PVCS to get
# and remove the file from the client (easier to do error checking this
# way - if PVCS doesn't put a new file there, we'll bomb at the submit)
unlink($client_file);
# Check for env parameters to use to specify archive file seperators - required if files
# contain things like "(" or ")" which are otherwise the default.
if ($ENV{PVCS_LEFT_SEPARATOR} && $ENV{PVCS_RIGHT_SEPARATOR}) {
print PVCS_FILELIST "-r$revision \"$archive" .
$ENV{PVCS_LEFT_SEPARATOR} . $client_file . $ENV{PVCS_RIGHT_SEPARATOR} . "\"\n";
}
else {
print PVCS_FILELIST "-r$revision \"$archive($client_file)\"\n";
}
}
# extract all required revisions from PVCS
# NOTE: PVCS ERROR OUTPUT IS BRAIN DEAD!
# -q Quiet NoSignOn -xe stderr
# 1 x x x nothing
# x 1 x x nothing
# 0 0 0 0 banner + 2 lines for each file extracted
# 0 0 0 1 banner
# 0 0 1 0 two lines for each file extracted
# 0 0 1 1 banner
# Observe that there is *no* way to get error output separately from normal
# output (it all goes to stderr). If that weren't bad enough, there is
# absolutely no way to redirect all stderr output without killing it.
# Furthermore, there's no way I can stop someone from specifying Quiet
# anyway (aside from following VCSCFG to the config file and editing it,
# which is not a friendly thing to do).
#
# SO: we do error checking indirectly - if PVCS didn't put the file there,
# the p4 submit will fail.
close(PVCS_FILELIST);
convert::run("get -q \@filelist");
# submit the change, and write out the association between PVCS
# archive and revision number and Perforce file and change number
$change_number = p4submit($c); # submit the change
my $checkin;
foreach $checkin (@checkins) {
my ($a,$r,$depot_filename) = @$checkin;
# write change number#filename to avoid confusion with filename#revision
print MAPPING "$a#$r#$change_number#$depot_filename\n";
}
# do all required p4 operations to handle labels and branches and deletions
foreach $op (@branch_ops) {
my ($source, $dest) = split(/#/,$op);
p4exec($dest, "integrate", $source);
}
p4submit($c) if(scalar(@branch_ops));
foreach $op (@delete_ops) {
p4exec($op, "integrate");
}
p4submit($c) if(scalar(@delete_ops));
}
# now do the labelling
print "\nLabelling started " . scalar(localtime()) . "\n";
for (keys(%labels_list)) {
convert::p4run(" -x $convert::metadata_dir/labels/$_ labelsync -l $_");
}
if ($USEDB_FILE) {
untie %labels_list;
untie %workfile;
untie %file_type;
untie %labels;
untie %branches;
untie %branch;
untie %added;
}
sub branch # return branch name for given archive and revision
{
return $convert::trunk_dir if($convert::ignore_branches);
my ($archive,$revision) = @_;
my $branch_number = $revision;
$branch_number =~ s/\.[0-9]+$//; # chop dot and last number off
return $convert::trunk_dir if($branch_number !~ /\./); # no dots -> trunk
my $archive_and_branch_number = join('#',$archive,$branch_number);
die "no branch name for revision $revision of $archive" if(!exists($branch{$archive_and_branch_number}));
return $branch{$archive_and_branch_number};
}
if ($USEP4) {
$p4->Final();
$p4form->Final();
}
# Run appropriate version of the command depending on if P4Perl is installed.
sub p4exec
{
# Need to distinguish filename parameter as it might need quoting in case of spaces
my $fname = shift;
my @cmd = @_;
my ($r, @result);
if ($USEP4) {
push @cmd, $fname;
@result = $p4->Run(@cmd);
log_p4errors($p4, "cmd:");
return @result if (!@result);
$r = join(" ", @result);
return $r;
}
else {
# print join(" ", @cmd) . " \"$fname\"\n"; #dso
return convert::p4run(join(" ", @cmd) . " \"$fname\"")
}
}
# Run appropriate version of submit
sub p4submit
{
my $c = shift;
my ($change_number);
if (!$USEP4) {
$change_number = $c->submit; # submit the change
}
else {
my $change_description = $c->change_description;
my ($form,$output,@result);
$form = $p4form->FetchChange();
if ($form->{'Files'}) {
$form->{'Description'} = $change_description;
@result = $p4form->SaveSubmit($form);
$output = join("\n", @result);
convert::log("Submit result:\n$output\n");
print_p4errors($p4form, "Submitting change");
# 2 forms of result - check for which one and extract the resulting change number.
if( $output =~ m/Change ([0-9]+) submitted./si ) {
$change_number = $1;
} elsif ( $output =~ m/Change [0-9]+ renamed change ([0-9]+) and submitted./si ) {
$change_number = $1;
}
else {
die "p4 submit aborted - conversion terminated. Output was:\n$output";
}
# fix date, user on submitted change
my $user = $c->author;
my $date = $c->datetime;
$form = $p4form->FetchChange($change_number);
$form->{'Date'} = $date;
$form->{'User'} = $user;
@result = $p4form->SaveChange($form, "-f");
print_p4errors($p4form, "Updating change");
print "Change $change_number submitted.\r"; # running total..
}
else {
print "WARNING: Change $change_number empty.\r";
}
}
return $change_number; # returns the change number
}
sub print_p4errors
{
my ($p4, $msg) = @_;
if ($p4->ErrorCount()) {
print "**p4errors - $msg:\n";
foreach my $e ($p4->Errors()){
print "$e\n";
}
}
}
sub log_p4errors
{
my ($p4, $msg) = @_;
if ($p4->ErrorCount()) {
convert::log("**p4errors - $msg:\n");
my @errs = $p4->Errors();
foreach my $e (@errs){
convert::log($e->[0]);
}
}
}