mkdepot.pl #6

#!/usr/bin/perl -w
#
# VSS to Perforce converter, phase III: construct Perforce depot
#
# $Id: //guest/perforce_software/utils/vsstop4/newp4perl/mkdepot.pl#6 $
#
# Copyright 1998 Perforce Software.  All rights reserved.
# Written by James Strickland, April 1998
#
# This script uses the metadata produced by earlier phases to direct a loop
# which extracts VSS revisions and performs the required Perforce commands
# to construct a Perforce depot corresponding to the (improved) VSS data.
#
# RHGC - Many modifications as per docs.
# RV   - Modified to speed up label processing for large changelists

require 5.0;
use strict;
use integer;
use lib '.';
use convert;
use Change;
use Env;
use File::Path;

use Win32::OLE;
use Win32::OLE qw(in);
use Win32::OLE::Const;
use Win32::OLE::Variant;

use utils;

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

# Handle older servers
my $p4d_submit_array_result = 0;
# Server version: P4D/NTX86/2005.1/89985 (2005/12/05)
my $p4info = utils::p4exec($p4, "info");
$p4info = @$p4info[0];  # Deref
if( $p4info->{'serverVersion'} =~ m@P4D/[^\/]+/([0-9]+)\.([0-9]+)(\.*[BETA]*)/@s) {
  my $ver = $1.$2;
  my $old_ver = "20051";
  if( $ver > $old_ver ) {
    $p4d_submit_array_result = 1;
  }
  my $msg = "P4D Server version: $ver, array_result: $p4d_submit_array_result\n";
  print_status($msg);
}
else {
  my $msg = "Unrecognised server version: convert::format_str($p4info)\n";
  print_status($msg);
  die $msg;
}

# See if we want to and can initialise VSS OLE interface
my $VSSDB;
if ($convert::vss_use_ole) {
  eval {$VSSDB = Win32::OLE->new('SourceSafe', 'Quit');};
  if (!$@) {
    my $m1 = "Using VSS OLE Automation interface\n";
    print_status($m1);

    my $SrcSafeIni = $ENV{"SSDIR"}."\\SRCSAFE.INI";
    Win32::OLE->Option(Warn => 3);  # Die on exceptions (with error message), e.g. if password wrong
    $VSSDB->Open($SrcSafeIni, $convert::vss_user, $convert::vss_password);
  }
}


# open all our input files
my $msg="can't open for read";
open(FILES,   "<$convert::metadata_dir/files")      or die $msg;
open(LABELS_SUMMARY,  "<$convert::metadata_dir/labels_summary")     or die $msg;
open(CHANGES, "<$convert::metadata_dir/changes")    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 (%file_type,    # maps archive            -> file type
                   # e.g. "$/foo"            -> "text"

    %labels,       # List of all labels

    %label_files,  # maps "revision archive" -> list of labels
                   # e.g. "1 $/foo"          -> "itworks","bobsyouruncle"

    %added,        # maps depot file         -> true/false
                   # e.g. "//depot/foo"      -> 1
    );

# We have to read the contents of the label file
open(LF,"<$convert::metadata_dir/db.labels") or die $msg;
while (<LF>) {
  chomp;
  my ($key,$val) = split(/#/,$_,2);
  $label_files{$key} = $val;
}
close(LF);

print "Reading file list\n";
# initialize %file_type
while(<FILES>) {
  chomp;
  my ($file_type,$file) = split(/ /,$_,2);
  $file_type{$file} = $file_type;
}
close(FILES);


print "Creating labels\n";

# initialize %label and run p4 label once for each label which is not a
# "delete" label
while(<LABELS_SUMMARY>) {
  chomp;
  my ($label,$timestamp) = split(/ /,$_,2);

  my $comment = '';
  $comment .= <LABELS_SUMMARY> while ($comment !~ /$convert::label_end_marker\n/);
  $comment =~ s/$convert::label_end_marker\n$//;

  $comment = "vsstop4 label" if ($comment =~ /^\s*$/);  # Set default comment.

  my $label_view = "\"//$convert::depot/$convert::depot_root...\"";

  # adjust the update time of the label
  my (@tm,$date);
  @tm=localtime($timestamp);
  $date=sprintf("%4d/%02d/%02d %02d:%02d:%02d",(($tm[5]>=70) ? $tm[5]+1900 : $tm[5]+2000),
                                                $tm[4]+1,$tm[3],$tm[2],$tm[1],$tm[0]);

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

  $form = $p4->FetchLabel($label);
  $form->{'Description'} = $comment;
  push @view, $label_view;
  $form->{'View'} = \@view;
  $form->{'Update'} = $date;
  $result = $p4->SaveLabel($form);
  convert::log("Label update:\n".convert::format_str($result));
  utils::p4errors_print($p4, "Updating label $label");

  $labels{$label} = 1;
  unlink ("$convert::metadata_dir/labels/$label");
}
close(LABELS_SUMMARY);

# print timestamp
print_status("Depot creation started         " . scalar(localtime()) . "\n");

# For each change,
# - retrieve revisions from VSS using 'get'
# - mark files as added or edited with 'p4 add' or 'p4 edit',
#   followed by 'p4 submit'
# - update list of file#rev associated with any pertinent labels

my $start_time = $convert::start_time;
my ($c,$op, $count);
my %label_hash;
$count = 0;
CHG: while( $c = get Change(\*CHANGES) ) {

  %label_hash = ();
  my ($change_number,@checkins);

  # Ignore change if a start_time is specified
  if ($start_time > $c->timestamp)
  {
    print "Ignoring changelist with timestamp: ". $c->datetime ."\n";
    next CHG;
  }

  convert::sum_log("Processing change: $count " . scalar(localtime())) if ($count % 100 == 0);
  $count += 1;
  
  my $index;
  foreach $index (@{$c->changelist}) {

    my $p4rev;

    my ($revision,$vss_file) = split(/ /,$index,2);

    my ($client_rel_dir,$client_file) = convert::p4dir_and_file( $vss_file);

    my $client_dir       = convert::join_paths( $convert::client_root,
                                                $client_rel_dir );

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

    # 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,
                                               $client_file );

    # get the file from VSS
    if ($VSSDB) {
      unlink("${client_dir}/${client_file}");
      my $item = $VSSDB->VSSItem($vss_file, 0);
      my $version = $item->Version(($file_type{$vss_file} eq "tempobj") ? "" : "$revision");
      $version->Get("${client_dir}/${client_file}");
    }
    else {
      convert::get_vss_file($vss_file,($file_type{$vss_file} eq "tempobj") ? "" : $revision,$client_dir,$client_file);
    }

    # see if the file is indeed there now
    if (-f "${client_dir}/${client_file}") {

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

      push(@checkins, [ $vss_file,$revision,$depot_file ] );
      # RHGC - because of restartability, add extra check
      if($added{$depot_file}) {
        p4exec_file(convert::p4escape_fname($depot_file), "edit") =~ /#(\d+) - opened for edit/ or die "p4 edit $depot_file failed";
        $p4rev=$1 +1;
      }
      elsif (p4exec_file(convert::p4escape_fname($depot_file), "files") !~ /no such file\(s\)/) {
        p4exec_file(convert::p4escape_fname($depot_file), "edit") =~ /#(\d+) - opened for edit/ or die "p4 edit $depot_file failed";
        $added{$depot_file}=1;
        $p4rev=$1 +1;
      } else {
        my @addcmd = ("add", "-f", "-t", "$file_type{$vss_file}");
        if ($convert::typemap_regexp) {
          # don't specify type when file is handled with p4 typemap
          if ($depot_file =~ /$convert::typemap_regexp/) {
            @addcmd = ("add");
          } else {
            print "file $depot_file not matched by typemap.\n";
          }
        }
        p4exec_file($depot_file, @addcmd) =~ /opened for add/ or die "p4 add $depot_file failed";
        $added{$depot_file}=1;
        $p4rev=1;
      }

      # check if this revision is labelled
      if(exists($label_files{$index})) {
        my $labels = $label_files{$index};
        my @label_list = split(/ /, $labels);
        for (@label_list) {
          $label_hash{"$convert::metadata_dir/labels/$_"} .= convert::p4escape_fname($depot_file) . "#$p4rev\n";
        }
      }

    } else {  # the file isn't there - the ss get failed

      my $errmsg = "ERROR: VSS file not found: ${vss_file}#${revision}\n";
      convert::log($errmsg);
      print STDERR $errmsg;
      if (!$convert::skip_ss_get_errors) {
        die "get_vss_file() revision $revision to $client_dir/$client_file failed";
      }

    }
  }

  # update the label files with the revision information collected above
#  print "\nUpdating label metadata        " . scalar(localtime()) . "\n";
  foreach my $label_file (keys %label_hash) {
  	open(LABELFILE,">>$label_file") or die "can't open label file $label_file: $!\n";
  	print LABELFILE $label_hash{$label_file};
  	close(LABELFILE);
  }

  # submit the change, and write out the association between VSS
  # archive and revision number and Perforce file and change number
  $change_number = p4submit($c); # submit the change

  my $checkin;
  foreach $checkin (@checkins) {
    my ($vss_file,$r,$depot_filename) = @$checkin;
    # write change number#filename to avoid confusion with filename#revision
    print MAPPING "$r#$change_number#" . convert::p4escape_fname($depot_filename) . "#$vss_file\n";
    # NOTE: $vss_file has to go last since it can contain # characters
  }
}

# now do the labelling
print_status("\nLabelling started              " . scalar(localtime()) . "\n");
for (keys(%labels)) {
  convert::p4run(" -x $convert::metadata_dir/labels/$_ labelsync -l $_");
}

print_status("\nLabelling finished             " . scalar(localtime()) . "\n");

$p4->Disconnect();

# Run p4 command for a file (first param)
sub p4exec_file
{
  # 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;
  @result = $p4->Run(@cmd);
  if ($p4->ErrorCount()) {
    foreach my $e ($p4->Errors()){
      push @result, $e;
    }
  }
  if ($p4->WarningCount()) {
    foreach my $e ($p4->Warnings()){
      push @result, $e;
    }
  }
  if($convert::debug_level > 0) {
    convert::log("p4 cmd: ".join(" ", @cmd));
    if (!@result || $#result < 0) {
      convert::log("result blank");
    }
  }
  return @result if (!@result);
  $r = convert::format_str(@result);
  if($convert::debug_level > 0) {
    convert::log("result: ".$r);
  }
  return $r;
}

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

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

  $form = $p4->FetchChange();
  if ($form->{'Files'}) {
    $form->{'Description'} = $change_description;

    $change_number = 0;
    @result = $p4->SaveSubmit($form);
    $output = join("\n", @result);

    # 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;
    }
    convert::log("Submit result:\n$output\n");
    utils::p4errors_print($p4, "Submitting change");

    if ($change_number == 0) {
      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 = $p4->FetchChange($change_number);
    $form->{'Date'} = $date;
    $form->{'User'} = $user;
    @result = $p4->SaveChange($form, "-f");
    utils::p4errors_print($p4, "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_status
{
  my $msg = shift;
  print $msg;
  convert::log($msg);
  convert::sum_log($msg);
}