# 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 Carp;
use Cwd;
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
$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
run p4run forward_slash rel_dir );
# 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'});
# 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::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::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
open(LOGFILE,">>logfile.log") 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.log") 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);
}
}
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) = @_;
croak "Fatal error: $dir does not begin with root $convert::root"
unless $dir =~ s@^\Q$convert::root\E(.*)/[^/]+$@$1@i;
$dir = substr($dir,1) if(substr($dir,0,1)) eq '/';
$dir = "$convert::depot_root/$dir" if $convert::depot_root;
$dir = lc($dir) if($convert::lowercase_pathnames);
if($convert::branch_level == 0) {
return $dir;
} elsif($convert::branch_level == 1) {
return join_paths($branch,$dir);
} elsif($convert::branch_level == 2) {
my ($first,$rest) = split(m(/),$dir,2);
return join_paths($first,$branch,$rest);
} else {
die "invalid branch level $convert::branch_level specified";
}
}
# 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;