mkdepot.pl #1

#!/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 P4 module installed
my $USEP4 = 0;
my $p4;
my $p4form;
eval{require P4; import P4;};
if (!$@) {
  $USEP4 = 1;
  print "Using P4Perl module\n";

  $p4 = new P4;
  $p4->SetPort($convert::p4port);
  $p4->SetClient($convert::p4client);
  $p4->SetUser($convert::p4user);
  # $p4->SetPassword( "som value" );    # if password's required
  $p4->MergeErrors(1);

  $p4->Connect() 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->SetPassword( "som value" );    # if password's required
  $p4form->MergeErrors(1);
  $p4form->ParseForms();

  $p4form->Connect() 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;
  unlink "$convert::metadata_dir/labels/$label";
}
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_file      = $convert::client_root . "/" . $convert::depot_root . $workfile{$archive};

    # needed to tell PVCS where to put the workfile
    my ($vol, $dirs, $file) = File::Spec->splitpath( $client_file );
    my $client_dir      = File::Spec->catpath($vol, $dirs, "");

    # 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} );
    my $depot_file = "//$convert::depot/$convert::depot_root" . $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( "//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)) {
  if (-f "$convert::metadata_dir/labels/$_") {
#    my @cmd = ("-x", "$convert::metadata_dir/labels/$_", "labelsync", "-l", $_);
#    my $result = p4exec($_, @cmd);
    convert::p4run(" -x $convert::metadata_dir/labels/$_ labelsync -l $_");
  }
}

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);
    convert::log($r);
    return $r;
  }
  else {
    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 {
        log_p4errors($p4form, "Submit:");
        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->[0] . "\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]);
    }
  }
}