convert.pm #7

# $Id: //guest/jeffery_g_smith/perforce/utils/sttop4/main/convert.pm#7 $
#
# StarTeam to Perforce Converter, common code module
#
# Copyright 1998 Perforce Software.  All rights reserved.
# Based on VSStoP4:
#   Written by James Strickland, April 1998
#   Maintained by Robert Cowham, since 2000
# Updated to support StarTeam conversions:
#   Jeffery G. Smith, MedPlus, Inc. 2004-2005

require 5.0;
package convert;
use strict;
use vars qw(@ISA @EXPORT);
use integer;
use Carp;
use Cwd;
use Time::Local;
use File::Path;
use Win32::Registry;
use IO::Handle;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( $metadata_dir $data_dir $root $client_root $time_interval
              $lowercase_pathnames $lowercase_filenames $lowercase_usernames
              $lowercase_extensions $typemap_regexp $perform_verify
              $bypass_metadata $logfile $debug_level $start_time
              $p4port $p4client $p4user $port log p4run run p4dir_and_file
              $format_date $format_time $exclude $label_ignore_regexp);


# set values of global variables

$convert::metadata_dir = "metadata";
$convert::data_dir     = "data";

# read the configuration file and set up needed variables
my %option = read_form("config.ini");

# StarTeam info
$convert::st_server              = (exists($option{'st_server'}))
                               ? $option{'st_server'} : '';

$convert::st_port              = (exists($option{'st_port'}))
                               ? $option{'st_port'} : '';

$convert::root           = (exists($option{'root'}))
                               ? $option{'root'} : '';

$convert::st_user          = (exists($option{'st_user'}))
                               ? $option{'st_user'} : '';

$convert::st_passwd        = (exists($option{'st_passwd'}))
                               ? $option{'st_passwd'} : '';

$convert::st_progid        = (exists($option{'st_progid'}))
                               ? $option{'st_progid'} : 'StarTeam.StServerFactory';



$convert::exclude            = (exists($option{'exclude'}))
                               ? $option{'exclude'} : "";

$convert::depot              = (exists($option{'depot'}))
                               ? $option{'depot'} : "depot";

# Main Perforce parameters P4PORT/CLIENT/USER
$convert::p4client           = (exists($option{'p4client'}))
                               ? $option{'p4client'} : $ENV{P4CLIENT};

$convert::p4port             = (exists($option{'p4port'}))
                               ? $option{'p4port'} : $ENV{P4PORT};

$convert::p4user             = (exists($option{'p4user'}))
                               ? $option{'p4user'} : $ENV{P4USER};

# Important conversion parameters
$convert::label_prefix       = (exists($option{'label_prefix'}))
                               ? $option{'label_prefix'} : "";

$convert::label_ignore_regexp = (exists($option{'label_ignore_regexp'}))
                               ? $option{'label_ignore_regexp'} : "";

# The first line of the depot
$convert::depot_root         = (exists($option{'depot_root'}))
                               ? $option{'depot_root'} : "main";

$convert::client_root        = forward_slash(cwd() . "/" . $convert::data_dir);

$convert::time_interval      = (exists($option{'time_interval'}))
                               ? $option{'time_interval'} : 600;

$convert::lowercase_pathnames= (exists($option{'lowercase_pathnames'}))
                               ? ($option{'lowercase_pathnames'} =~ /y/i) : 0;

$convert::typemap_regexp=      (exists($option{'typemap_regexp'}))
                               ? $option{'typemap_regexp'} : "";

$convert::lowercase_filenames= (exists($option{'lowercase_filenames'}))
                               ? ($option{'lowercase_filenames'} =~ /y/i) : 0;

$convert::lowercase_extensions= (exists($option{'lowercase_extensions'}))
                               ? ($option{'lowercase_extensions'} =~ /y/i) : 0;

$convert::lowercase_usernames= (exists($option{'lowercase_usernames'}))
                               ? ($option{'lowercase_usernames'} =~ /y/i) : 0;

$convert::logfile        = (exists($option{'logfile'}))
                               ? $option{'logfile'} : 'convert.log';

$convert::debug_level        = (exists($option{'debug_level'}))
                               ? $option{'debug_level'} : 0;

$convert::username_mapping    = (exists($option{'username_mapping' }))
				            ? $option{'username_mapping'} : '';

$convert::perform_verify=      (exists($option{'perform_verify'}))
                               ? ($option{'perform_verify'} =~ /y/i) : 0;

# Validate required parameters
die "must specify a StarTeam server\n" unless $convert::st_server;
die "must specify a StarTeam server port\n" unless $convert::st_port;
die "must specify a StarTeam user\n" unless $convert::st_user;
die "must specify a StarTeam password\n" unless $convert::st_passwd;
die "must specify a project list\n" unless $convert::root;

# If start_time is specified then convert to timestamp, 0 means process all changes
$convert::start_time         = (exists($option{'start_time'}))
                               ? mktimestamp($option{'start_time'}) : 0;

# Set up by reading registry
($convert::format_date, $convert::format_time) = read_date_time_format_from_registry();

# Construct the user mapping table
%convert::usernames_map = ();
if ($convert::username_mapping)
{
    open(MAPFILE,$convert::username_mapping)
        || die("unable to open $convert::username_mapping for reading: $!\n");
    my @mappings = <MAPFILE>;
    close(MAPFILE);
    map(chomp,@mappings);
    foreach my $mapping (@mappings)
    {
        my ($st_user,$p4_user) = split(/=/,$mapping);
        $convert::usernames_map{$st_user} = $p4_user;
    }
}

# Run a command, optionally piping a string into it on stdin.
# Returns whatever the command printed to stdout.  The whole thing is
# optionally logged.  NOTE that stderr is not redirected.
sub run
{
  my ($syscall,$stuff_to_pipe_in) = @_;
  my $result;

  if(defined($stuff_to_pipe_in)) {

    # Use a temporary file because not all systems implement pipes
    open(TEMPFILE,">pipeto") or die "can't open pipeto: $!\n";
    print TEMPFILE $stuff_to_pipe_in;
    close(TEMPFILE);
    $result = `$syscall <pipeto`;
    unlink("pipeto");
  } else {
    $result = `$syscall`;
  }

  ($convert::debug_level > 0) && convert::log("Command: $syscall\n$result\n", 1);

  return $result;
}

# Set up global logfile and make sure it's autoflush on in case of crash
sub openlog
{
    my ($action) = @_;
    
    ($action eq "start") && (-e $convert::logfile) &&
        (unlink($convert::logfile) || die("unable to remove old logfile: $!\n"));
        
    $| = 1;
    open(convert::LOGFILE,">>$convert::logfile") or die "can't open logfile: $!";
    convert::LOGFILE->autoflush(1);

    convert::log("=> Log ${action}ed by $0 on " . localtime() . " <=\n", 1, 1);
}

sub closelog
{
    convert::log("=> Log closed by $0 on " . localtime() . " <=\n", 1, 1);
    close(convert::LOGFILE);
}

sub log
{
  my ($data, $quiet, $bare) = @_;

  $bare || print convert::LOGFILE "Log: ";
  print convert::LOGFILE $data;
  $quiet || print $data;
}

# Run a p4 command  - specifying p4 environment explicitly
sub p4run
{
  my ($cmd,$stuff_to_pipe_in) = @_;

  my $p4cmd = "p4 -p " . $convert::p4port .
                " -c " . $convert::p4client .
                " -u " . $convert::p4user .
                " " . $cmd;
  if (defined($stuff_to_pipe_in)) {
    return run($p4cmd, $stuff_to_pipe_in);
  }
  else {
    return run($p4cmd);
  }
}


# Convert from "yyyy/mm/dd hh:mm:ss" to timestamp
sub mktimestamp
{
  my $date=shift;

  my ($year,$month,$day,$hour,$min,$sec);
  die "can't parse start_timestamp" unless
	(($year,$month,$day,$hour,$min,$sec) = ($date =~ m@(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)@));

  my $timestamp=timelocal($sec, $min, $hour, $day, $month - 1, $year);
  return $timestamp;
}

sub read_form # read a Perforce style form
{
  my $file = shift;
  my (%hash,$current_keyword,$value);

  open(F,"<$file") or croak("can't open $file: $!");
  while(<F>) {

    s/\s*#.*$//;  # kill comments and any whitespace preceding the comment

    if(/^$/) {    # empty line or line with just a comment

      undef($current_keyword);

    } elsif(substr($_,0,1) eq "\t") {

      croak("unrecognized line") if(!defined($current_keyword));
      s/^\t//;
      $hash{$current_keyword} .= $_;

    } elsif(/(.*?):\s*(.*)/) { # keyword is everything up to the *first* colon

      $current_keyword = $1;
      $value = $2;
      $value =~ s/\s*$//;   # Trim white space at end.
      $hash{$current_keyword} = $value;

    }

  }
  close(F);
  return %hash;
}


sub forward_slash
{
  my $s = shift;

  $s =~ s@\\@/@g;

  return $s;
}


# p4dir_and_file computes the directory and filename relative to the client root
# given the VSS filename.

sub p4dir_and_file
{
  my $client_rel_dir = shift;

  $client_rel_dir =~ s%[\000-\031@#]%_%g; # convert unprintable, @, # to _

  $client_rel_dir =~ s@^\$@$convert::depot_root@;
  $client_rel_dir =~ s@/([^/]*)$@@; # strip off filename
  my $client_file = $1;

  $client_rel_dir = lc($client_rel_dir) if($convert::lowercase_pathnames);
  $client_file    = lc($client_file   ) if($convert::lowercase_filenames);

  if($convert::lowercase_extensions)
  {
      $client_file =~ /(.*?)(\.[^.]+)?$/;
      my ($cl_base,$cl_ext) = ($1,$2);
      $cl_ext = lc($cl_ext);
      $client_file = $cl_base . $cl_ext;
  }

  return ($client_rel_dir,$client_file);
}


# return a string joining the pathname components,
# ensuring there is one / between components and there is no trailing slash

sub join_paths
{
  my $path="";

  for (@_) {
    if(defined($_) && $_ ne "") {
      $path .= (substr($_,-1) eq '/') ? $_ : $_ . '/';
    }
  }
  chop($path) if(substr($path,-1) eq '/');
  return $path;
}

# get the given file from VSS (specified as a complete "project" path)
# and name it according to its name in Perforce (given client dir and filename)

sub get_vss_file
{
  my ($vss_file,$revision,$client_dir,$client_file) = @_;

  mkpath($client_dir);
  my $client_filepath = join_paths($client_dir, $client_file);
  unlink($client_filepath);
  $revision = "-v$revision" if $revision; # if $revision not set, don't give -v flag (tempobj hack)
  convert::run("ss get \"$vss_file\" -W -GL\"${client_dir}\" $revision $convert::ss_options"); # get it writable so that we can unlink it later
  $vss_file =~ m@/([^/]*)$@;
  my $vss_filepath = join_paths($client_dir, $1);
  rename($vss_filepath,$client_filepath) unless($vss_filepath eq $client_filepath);
}


# Read current date/time format settings from Registry and parse appropriately

sub read_date_time_format_from_registry
{
  my $Register = "Control Panel\\International";
  my ($hkey, %values, $key);
  $::HKEY_CURRENT_USER->Open($Register,$hkey)|| die $!;
  $hkey->GetValues(\%values);
  $hkey->Close();

  my $sShortDate = $values{"sShortDate"}->[2];	# Date format, e.g. dd/MM/yyyy
  my $iTime = $values{"iTime"}->[2];	# 0 = 12 hour, 1 = 24 hour format
  my $sTime = $values{"sTime"}->[2];	# time seperator (usually ":")
  my $sDate = $values{"sDate"}->[2];	# Date seperator (usually "/")
  my $s1159 = $values{"s1159"}->[2];	# AM indicator (if required)
  my $s2359 = $values{"s2359"}->[2];	# PM indicator (if required)

  # Remove duplicates of d/M/y and change to lowercase
  $sShortDate =~ s/d+/d/i;
  $sShortDate =~ s/m+/m/i;
  $sShortDate =~ s/y+/y/i;

  my $TimeFormat = "H" . $sTime . "M";
  $TimeFormat .= "p" if $iTime == 0;

  return $sShortDate, $TimeFormat;
}

1;