convert.pm #1

# This module contains all code common to different phases of the
# VSS to Perforce converter.
#
# $Id: //guest/ashish_melanta/perforce/utils/vsstop4/main/convert.pm#1 $
#

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
              $skip_ss_get_errors $bypass_metadata $debug_level $start_time
              $p4port $p4client $p4user $port log sum_log p4run run p4dir_and_file
              $format_date $format_time $exclude $vsscorrupt $label_ignore_regexp
              $ss_options $vss_use_ole $vss_user $vss_password);


# set values of global variables

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

# Set up global logfile and make sure it's autoflush on in case of crash
open(LOGFILE,">>logfile.log") or die "can't open logfile: $!";
LOGFILE->autoflush(1);

# read the configuration file and set up needed variables
my %option;
if (defined($ENV{VSSTOP4_CONFIG})) {
  %option = read_form($ENV{VSSTOP4_CONFIG});
} else {
  %option = read_form("config.ini");
}

my ($date_format, $time_format) = read_date_time_format_from_registry();

die "must specify root" unless exists($option{'root'});
$convert::root                  = forward_slash($option{'root'});

$convert::exclude               = get_option('exclude', "");

$convert::vsscorrupt            = get_yn_option('vsscorrupt');

$convert::depot                 = get_option('depot', "depot");

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

$convert::p4port                = get_option('p4port', $ENV{P4PORT});

$convert::p4user                = get_option('p4user', $ENV{P4USER});

$convert::label_prefix          = get_option('label_prefix', "");

$convert::label_ignore_regexp   = get_option('label_ignore_regexp', "");

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

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

$convert::time_interval         = get_option('time_interval', 600);

$convert::lowercase_pathnames   = get_yn_option('lowercase_pathnames');

$convert::typemap_regexp        = get_option("typemap_regexp", "");

$convert::lowercase_filenames   = get_yn_option('lowercase_filenames');

$convert::lowercase_extensions  = get_yn_option('lowercase_extensions');

$convert::lowercase_usernames   = get_yn_option('lowercase_usernames');

$convert::ss_options            = make_ss_options();

$convert::vss_use_ole           = get_yn_option('vss_use_ole');

$convert::vss_user              = get_option("vss_user", "");

$convert::vss_password          = get_option("vss_password", "");

$convert::debug_level           = get_option('debug_level', 0);

$convert::bypass_metadata       = get_yn_option('bypass_metadata');

$convert::perform_verify        = get_yn_option('perform_verify');

$convert::skip_ss_get_errors    = get_yn_option('skip_ss_get_errors');

# Set up by reading registry
$convert::format_date       = ($date_format);
$convert::format_time       = ($time_format);


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

# Get a standard option
sub get_option
{
  my ($name, $default) = @_;
  
  return exists($option{$name}) ? $option{$name} : $default;
}

# Get a standard option
sub get_yn_option
{
  my ($name) = @_;

  return (exists($option{$name})) ? ($option{$name} =~ /y/i) : 0;
}

# Check valid options including user/password
sub make_ss_options
{
  my $options = get_option("ss_options", "");
  $options .= " -Y" . get_option("vss_user", "") . "," . get_option("vss_password", "");
  return $options;
}

# Ensure it has trailing slash
sub check_root
{
  my $root = shift;
  if ($root eq "") {
  } elsif($root !~ /\/$/) {
    $root .= "/";
  }
  return $root;
}

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

  if($convert::debug_level > 0) {
    print LOGFILE "\n\nCommand: $syscall\n";
    print LOGFILE $result;
  }

  return $result;
}


sub log
{
  my $data = shift;

  print LOGFILE "Log: $data\n";
}

# Print to summary log file
sub sum_log
{
  my $data = shift;
  open(SUMLOGFILE,">>sumlogfile.log") or die "can't open sumlogfile: $!";
  print SUMLOGFILE "$data\n";
  close(SUMLOGFILE);
}

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

  &log("Date Format: $sShortDate\n");
  &log("Time Format: $TimeFormat\n");

  return $sShortDate, $TimeFormat;
}

1;