# 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 $pvcs_user $pvcs_passwd 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::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::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 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() { 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 = "$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;