convert.pm #6

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

require 5.0;
package convert;
use strict;
use vars qw(@ISA @EXPORT);
use integer;
use Time::Local;
use POSIX qw(strftime);
use IO::Handle;
use Carp;
use Cwd;
use Env;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( $metadata_dir $data_dir $root $depot $depot_root $client_root $time_interval
              $trunk_dir $ignore_branches $branch_level $branch_prefix $ignore_vlogerrs
              $lowercase_filenames $lowercase_extensions $lowercase_branchnames $lowercase_usernames
              $list_all_files $delete_label_regex $label_prefix $debug_level $arc_file_regex
              %filetype_regex $perform_verify $projects
              $p4port $p4client $p4user $port log $pvcs_user $pvcs_passwd
              run p4run forward_slash rel_dir );


# 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
my $logfile_name = "logfile.log";
if (-f $logfile_name) {
  my $modtime = (stat($logfile_name))[9];
  my $suffix = strftime("%Y%m%d%H%M%S", localtime($modtime));
  rename($logfile_name, "logfile-$suffix.log");
}
open(LOGFILE,">>$logfile_name") or die "can't open logfile: $!";
LOGFILE->autoflush(1);

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

die "must specify root" unless exists($option{'root'});

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

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

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

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

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

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

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

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

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

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

$convert::ignore_vlogerrs    = (exists($option{'ignore_vlogerrs'}))
                               ? ($option{'ignore_vlogerrs'} =~ /y/i) : 0;
                               
$convert::branch_level       = (exists($option{'branch_level'}))
                               ? $option{'branch_level'} : 1;
die "branch_level must be 0, 1 or 2"
  if($convert::branch_level !=0 && $convert::branch_level !=1 && $convert::branch_level !=2);
die "branch_level can only be 0 if ignore_branches set to 'yes'"
  if($convert::branch_level == 0 && !$convert::ignore_branches);

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

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

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

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

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

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

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

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


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

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

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

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

$convert::arc_file_regex    = (exists($option{'arc_file_regex' }))
                               ? $option{'arc_file_regex'} : '\.[^\.]{2}[vV]$';

# construct regular expressions for each file type option given
for (keys(%option)) {
  if(/^type_/) {
    my $type = substr($_,5); # strip off the type_
    my @extensions = split(/\s+/,$option{$_});
    @extensions = map { "\\.$_\$" } @extensions;
    $convert::filetype_regex{$type} = join('|',@extensions);
  }
}


# 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`;
  } 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
    print LOGFILE "\n\nCommand: $syscall\n";
    print LOGFILE $result;
  }

  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
  print LOGFILE "Log: $data\n";
}

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


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


# rel_dir computes the directory relative to the client root
# given the archive name (fully qualified path) and the branch name.
# i.e. it strips off the pvcs root and filename, then inserts the branch
# name in the appropriate location based on branch_level.

sub rel_dir
{
  my ($dir,$branch) = @_;

  $dir = substr($dir,1) if(substr($dir,0,1)) eq '/';
  $dir = lc($dir) if($convert::lowercase_pathnames);
  my @parts;
  push @parts, $convert::depot_root if($convert::depot_root);
  if($convert::branch_level == 0) {
    push @parts, $dir;
  } elsif($convert::branch_level == 1) {
    push @parts, $branch, $dir;
  } elsif($convert::branch_level == 2) {
    my ($first,$rest) = split(m(/),$dir, 2);
    push @parts, $first, $branch, $rest;
  } else {
    die "invalid branch level $convert::branch_level specified";
  }
  return join_paths(@parts);
}


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


1;