convert.pm #1

# This module contains all code common to different phases of the
# VSS to Perforce converter.

require 5.0;
package convert;
use strict;
use vars qw(@ISA @EXPORT);
use integer;
use Carp;
use Cwd;
use Time::Local;
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 p4run run emkdir p4dir_and_file
              $format_date $format_time $exclude $vsscorrupt $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");
die "must specify root" unless exists($option{'root'});

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

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

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

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

$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::ss_options         = (exists($option{'ss_options'}))
                               ? $option{'ss_options'} : "";

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

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

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

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

# See comments in Config for settings
$convert::format_date       =  (exists($option{'format_date'}))
                               ? $option{'format_date'} : "m/d/y";

$convert::format_time       =  (exists($option{'format_time'}))
                               ? $option{'format_time'} : "H:Mp";


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

# 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) {
    # append to a file - that way if the converter dies the file will
    # be up to date, and this mechanism doesn't rely on an open filehandle
    open(LOGFILE,">>logfile") or die "can't open logfile: $!";
    print LOGFILE "\n\nCommand: $syscall\n";
    print LOGFILE $result;
    close(LOGFILE);
  }

  return $result;
}


sub log
{
  my $data = shift;

    # append to a file - that way if the converter dies the file will
    # be up to date, and this mechanism doesn't rely on an open filehandle
    open(LOGFILE,">>logfile") or die "can't open logfile: $!";
    print LOGFILE "\n\nLog: $data\n";
    close(LOGFILE);
}

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


# Ensure a directory exists - make it and all required parents if it doesn't.
# Die on failure.
# Accepts a list of directories, makes them all with perms 0755

sub emkdir
{
  my ($current,$prev,$dir);

  for (@_) {
    next if(length($_) < 2);

    # skip over drive letters and UNCs to avoid calling (eg)
    # mkdir a: or mkdir //machinename
    $prev= (/^[a-zA-Z]:/) ? 2 : ( (m@//@) ? index($_,'/',2) : 0);

    # mkdir for each subpath as necessary
    do {
      $current=index($_,'/',$prev+1);
      $dir= ($current == -1) ? $_ : substr($_,0,$current);
      if(! -d $dir) { mkdir($dir,0755) or croak "can't mkdir $dir: $!"; }
      $prev=$current;
    } while( $current != -1);
  }
}

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

  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

      $hash{$current_keyword=$1} = $2;

    }

  }
  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) = @_;

  emkdir($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);
}


1;