mkdepot.pl #8

#!/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 - 2006.
# Modified by Sven Erik Knop, 2009 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;
use Data::Dumper;

# 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
    );

use utils;

# Check for P4 module installed
my $p4 = utils::p4api;
$p4->SetPort($convert::p4port);
$p4->SetClient($convert::p4client);
$p4->SetUser($convert::p4user);
# $p4->SetPassword( "som value" );    # if password's required
$p4->Connect() or die( "Failed to connect to Perforce Server: $convert::p4port $!\n" );

# initialize %workfile and %file_type
while(<FILES>) {
  chomp;
  my ($archive,$work,$file_type) = split(/#/,$_);
  $workfile{$archive}=$work;
  $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);

print "Updating labels               " . scalar(localtime()) . "\n";

# 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/...";

  my ($form, @view, @result);

  $form = $p4->FetchLabel($label);
  $form->{'Description'} = $comment;
  push @view, $label_view;
  $form->{'View'} = \@view;
  @result = $p4->SaveLabel($form);
  convert::log("Label update:\n".join("\n", @result));
  print_p4errors($p4, "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);

  # 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;
  my @client_filelist;
  foreach $index (@{$c->changelist}) {

    my ($archive,$revision) = split(/#/,$index);

    my ($our_branch, $parent) = branch($archive,$revision);
    my $client_rel_file = convert::rel_dir( $workfile{$archive},$our_branch);
    
    $revision =~ /\.(\d+)$/;
    my $last_revision = $1;
    
    # needed to ensure the directory exists to hold the workfile
    # [SEK] This is now in the correct branch location.
    my $client_file      = $convert::client_root . "/" . $client_rel_file;

    # 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_file );

    # create all needed directories on the path
    mkpath($client_dir);

    # check to see if this is a branch point
    # [SEK] need this to store the correct branch name to make branch() work
    
    my $branch_reference = '';
    
    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_reference = join('#',$archive,$branch_rev);
        $branch{$branch_reference} = [$branch_name];
      }

    }

    # schedule p4 add or edit operation
    # depending on whether file has already been added

    push(@checkins, [ $archive,$revision,$depot_file ] );
    my $rev;
    
    if ( $parent and $last_revision == 0 ) {
      p4exec($depot_file, "integrate", $parent);
      p4exec($depot_file, "edit"); # this downgrades the integrate to an edit to allow changing of content
      $rev = 1;
      $added{$depot_file} = 1;
    } elsif ( $added{$depot_file}) {
      @result = p4exec($depot_file, "edit");
      $rev = $result[0]->{'workRev'} + 1;
    } else {
      my @addcmd = ("add", "-t", "$file_type{$archive}");
      p4exec($depot_file, @addcmd); 
      $rev = 1;
      $added{$depot_file} = 1;
    }

    if ($branch_reference) {
      my $branch_source = "$depot_file#$rev";
      push (@{$branch{$branch_reference}}, $branch_source);
    }

    # 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;
        }
      }
    }

    push @client_filelist, $client_file;
    # 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");

  # Fix any timestamp strangeness on files - PVCS can create files outside normal epoch, e.g.
  # Mod time > 2038. This causes problems for Perforce so we fix them.
  foreach my $client_file (@client_filelist) {
    if ((stat($client_file))[9] == -1) {
      my $msg = "Changing timestamp on $client_file\n";
      print $msg;
      convert::log($msg);
      my @files_to_change;
      my $mtime = time;
      push(@files_to_change, $client_file);
      chmod 0755, $client_file;
      my $uresult = utime $mtime, $mtime, @files_to_change;
      if ($uresult == 0) {
        $msg = "Failed to convert time!!!";
        print $msg;
        convert::log($msg);
      }
    }
  }
  
  # 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";
  }

  foreach $op (@delete_ops) {
    p4exec($op, "delete");
  }

  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}} ;
}

$p4->Disconnect();

# 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);

  push @cmd, $fname;
  convert::log(Dumper(@cmd));
  @result = $p4->Run(@cmd);
  log_p4errors($p4, "cmd:");
  return @result if (!@result);
  convert::log(Dumper(@result));
  return @result;
}

# Run appropriate version of submit
sub p4submit
{
  my $c = shift;
  my ($change_number) = "UNSET";

  my $change_description = $c->change_description;
  my ($form,$output,@result);

  $form = $p4->FetchChange();  
  if ($form->{'Files'}) {
    $form->{'Description'} = $change_description;
    $result = $p4->RunSubmit($form)->[0];
    print_p4errors($p4, "Submitting change");
    $change_number = $result->{'change'};

    # fix date, user on submitted change
    my $user = $c->author;
    my $date = $c->datetime;

    $form = $p4->FetchChange($change_number);
    $form->{'Date'} = $date;
    $form->{'User'} = $user;
    @result = $p4->SaveChange($form, "-f");
    print_p4errors($p4, "Updating change");

    print "Change $change_number submitted.\r"; # running total..
  }
  else {
    my $errmsg = "WARNING: Empty changelist.\r";
    print $errmsg;
    convert::log($errmsg);
    convert::log(Dumper($form));
  }
  return $change_number; # returns the change number
}

sub print_p4errors
{
  my ($p4, $msg) = @_;
  convert::log($msg);
  if ($p4->ErrorCount()) {
    print "**p4errors - $msg:\n";
    print Dumper($p4->Errors());
    log_p4errors($p4, $msg);
  }
}

sub log_p4errors
{
  my ($p4, $msg) = @_;
  if ($p4->ErrorCount()) {
    convert::log("**p4errors - $msg:\n");
    convert::log(Dumper($p4->Errors()));
  }
  if ($p4->WarningCount()) {
    convert::log("**p4warnings - $msg:\n");
    convert::log(Dumper($p4->Warnings()));
  }
}