#!/usr/bin/perl
# please see 'perldoc mks2cvs' or 'mks2cvs -h' for help.
require v5.6.0; # for many auto vivified handles
use strict;
use vars qw/$VERSION %CONFIG $SPIN @SPIN %FILE_CHECK_CACHE %TAGS_CACHE %MAP_BACK %MAP_FORWARD/;
$VERSION='1.1';
# VERSION HISTORY
# 1.1 - Enables spaces in filenames referred to by .pj files.
# 1.0 - Initial release.
use File::Basename;
# Copyright (c) 2001 "Brandon L. Golm"
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself provided this message and author
# information are retained.
@SPIN=('-','-','\\','\\','|','|','/','/');
&check_flags;
# set defaults
$CONFIG{'recurse' } = 1 unless defined $CONFIG{'recurse' };
$CONFIG{'inherit-tags'} = 1 unless defined $CONFIG{'inherit-tags'};
$CONFIG{'top-tag-only'} = 0 unless defined $CONFIG{'top-tag-only'};
$CONFIG{'dir-sep' } = '/' unless defined $CONFIG{'dir-sep' };
$CONFIG{'mks-sticky' } = 'MKS_IMPORT' unless defined $CONFIG{'mks-sticky' };
$CONFIG{'cvs-sticky' } = 'CVS_START' unless defined $CONFIG{'cvs-sticky' };
&main;
exit;
# If you like check_flags more than alternatives, please steal it and use it. I did.
sub check_flags {
local $_;
my (
@fatal,
@warn ,
@info ,
);
while ($ARGV[0] =~ /^-/) {
$_ = shift(@ARGV);
study;
/^-+h(?:elp)?(?:(?:[:=])(.+))?$/i && do {
&usage($1);
exit(1);
};
s/^-+script[:=]?// && do {
if ($_ eq '') {
print "options:
\"top\" extract mks2cvs-all-top-level to make calling
mks2cvs easier for multiple Projects. Creates destination
directories for you too!
\t$0 --script=top > mks2cvs-toplevel
\"verify\" extracts verify-all-cvs shell script to check
your CVS directories after you've done the conversion
\t$0 --script=verify | sh -s --
-or-
\t$0 --script=verify > verify-all-cvs
Then make them executable, or run \"sh script-name options\"\n\n";
exit(1);
}
/^verify/ && do {
while () {
last if /^VERIFY\-ALL\-CVS/;
}
while () {
last if /^VERIFY\-ALL\-CVS/;
print;
}
exit(1);
};
/^top/ && do {
while () {
last if /^MKS2CVS-ALL-TOP-LEVEL/;
}
while () {
last if /^MKS2CVS-ALL-TOP-LEVEL/;
s/MKS2CVS\-PROGRAM/$0/;
print;
}
exit(1);
};
print "script $_ not found\n";
exit(1);
};
s/^-+src[:=]?// && do {
if ($_ eq '') {
push @fatal,
"--src can't be blank";
next;
}
push @warn,
"redefining --src from \n$CONFIG{'src'}\nto\n$_\n"
if defined $CONFIG{'src'};
if (defined $CONFIG{'dir-sep'}) {
s/($CONFIG{'dir-sep'})+/$1/g;
s/^\.{1}$CONFIG{'dir-sep'}/$CONFIG{'dir-sep'}/;
s/$CONFIG{'dir-sep'}\.{1}$CONFIG{'dir-sep'}/$CONFIG{'dir-sep'}/
while m~[^.]\.$CONFIG{'dir-sep'}~;
}
else {
s~/+~/~g;
s~^\./~ ~;
s~/\./~/~
while m~[^.]\./~; # since matches can overlap, can't use //g
}
/\.\./ && do {push
@fatal,
"--src: $_ contains '..' previous dir link. I can't handle that.";
next};
-e || do {push @fatal, "--src: $_ does not a exist" ; next};
-f || do {push @fatal, "--src: $_ is not a file" ; next};
/\.pj$/ || do {push @fatal, "--src: $_ is not a .pj file"; next};
$CONFIG{'src'} = $_;
next;
};
s/^-+de?st[:=]?// && do {
if ($_ eq '') {
push @fatal,
"--dest can't be blank";
next;
}
push @warn,
"redefining --dest from \n$CONFIG{'dest'}\nto\n$_\n"
if defined $CONFIG{'dest'};
unless (-d) {
push @fatal,
"--dest must be a directory, $_ is not";
next;
}
if (opendir(my $dirh,$_)) {
my $i;
for (grep {!/^\.{1,2}/} readdir($dirh)) {
$i++;
}
push @fatal,
join '',"-dest $_ has $i thing",$i==1?'':'s'," in it. It should be empty"
if $i;
closedir($dirh);
}
else {
push @fatal,
"couldn't open --dest $_ for reading: $!";
}
$CONFIG{'dest'} = $_;
next;
};
/^-+fix-case$/ && do {
$CONFIG{'fixcase'}++;
push @info,
"\n* * * NOTE * * *
I will perform case fixing for you. This is no big
deal if the source files came from a Windows filesystem.
In the small chance that there are duplicates like:
\t/Foo /foo /fOO
I might freak out and break everything.\n";
next;
};
s/^-+dir-+sep[:=]?// && do {
if ($_ eq '') {
push @fatal,
"--dir-sep can't be blank";
next;
}
push @warn,
"redefining option --dir-sep from $CONFIG{'dir-sep'} to $_"
if defined $CONFIG{'dir-sep'};
push @warn,
"your directory separator ('--dir-sep') \"$_\" is more than one character"
if length > 1;
$CONFIG{'dir-sep'} = $_;
next;
};
s/^-+mks-sticky[:=]// && do {
push @warn,
"redefining option --mks-sticky from $CONFIG{'mks-sticky'} to $_"
if defined $CONFIG{'mks-sticky'};
push @fatal,
"--mks-sticky must start with a letter and be letters numbers _ and -"
unless /^[a-zA-Z][a-zA-Z0-9-_]*$|^$/;
$CONFIG{'mks-sticky'} = $_;
next;
};
s/^-+cvs-sticky[:=]// && do {
push @warn,
"redefining option --cvs-sticky from $CONFIG{'cvs-sticky'} to $_"
if defined $CONFIG{'cvs-sticky'};
push @fatal,
"--cvs-sticky must start with a letter and be letters numbers _ and -"
unless /^[a-zA-Z][a-zA-Z0-9-_]*$|^$/;
$CONFIG{'cvs-sticky'} = $_;
next;
};
s/^-+inherit-tags[:=]?// && do {
if ($_ eq '') {
push @fatal,
"--inherit-tags can't be blank";
next;
}
push @warn,
join('',"redefining option --inherit-tags from ",$CONFIG{'inherit-tags'}?'on':'off'," to $_")
if defined $CONFIG{'inherit-tags'};
if (/^no?$|^0$|^off$/i) {
$CONFIG{'inherit-tags'} = 0;
}
elsif (/^y(?:es)?$|^1$|^on$/i) {
$CONFIG{'inherit-tags'} = 1;
}
else {
push @fatal,
"unknown value '$_' for option --inherit-tags";
}
next;
};
s/^-+top-tag-only[:=]?// && do {
if ($_ eq '') {
push @fatal,
"--top-tag-only cn't be blank";
next;
}
push @warn,
join('',"redefining option --top-tag-only from ",$CONFIG{'top-tag-only'}?'on':'off'," to $_")
if defined $CONFIG{'top-tag-only'};
if (/^no?$|^0$|^off$/i) {
$CONFIG{'top-tag-only'} = 0;
}
elsif (/^y(?:es)?|^1$|^on$/i) {
$CONFIG{'top-tag-only'} = 1;
}
else {
push @fatal,
"unknown value '$_' for option --top-tag-only";
}
next;
};
push @fatal, "what the freak is: $_";
#last if /^-packages$/;
}
if (! defined $CONFIG{'dest'} || ! defined $CONFIG{'src'}) {
push @fatal, "You need to define both Source and Destination!";
}
if (@fatal) {
{
local $, = local $\ = "\n";
print "\nPlease correct these errors:\n\n", @fatal;
}
&usage;
exit(1);
}
if (@warn) {
print "WARNING\n\n";
{
local $, = local $\ = "\n";
print @warn;
}
local $| = 1;
print "\n\nAre you okay with those warnings? (y/yes/n/no) [no] > ";
die "bye\n"
unless =~ /^y(es)?\r?\n?$/i;
}
{ # I like blocks
local $, = local $\ = "\n";
print @info;
}
}
sub usage {
print "\n\nusage:\n";
while () {
last if /^=head\d+\s+USAGE\s*$/;
}
while () {
last if /^=/;
print;
}
}
sub main {
my $src_dir = dirname($CONFIG{'src' });
my $dest_dir = $CONFIG{'dest'};
my $catalog = {};
chdir $src_dir || die "can't cd to $src_dir: $!";
$| = 1;
print "Opening all packages and creating a catalog of all referenced files.\n";
&parse_pj(
-catalog => $catalog,
-pkg => $CONFIG{'src'}
);
print "\r \nGenerating tags for all files\n";
&generate_tags(
-catalog => $catalog,
);
print "\r \nChecking for files that might get left behind.\n";
my ($dirs, @un_mentioned) = &find_un_mentioned_files_find_dirs(
-top => $src_dir,
-catalog => $catalog
);
if (@un_mentioned) {
print "\r \n\nThe following files are not in any packages, but will be converted anyway\n";
local $\="\n";
for (@un_mentioned) {
print;
$catalog->{$_} = 0 unless defined $catalog->{$_};
}
}
# print "\r \nCreating directory structure\n";
# {
# for (@{$dirs}) {
# s/^$src_dir/$dest_dir/o;
# print &spin;
# next if -d;
# mkdir($_) || die "can't create directory: $!";
# }
# }
print "\r \nConverting all MKS files to CVS and placing them in $dest_dir\n";
&convert_all(
-catalog => $catalog,
);
print "\r \n\n* * * IMPORTANT * * *
It is your responsibility to change the files that were just created
to have the proper ownership and permissions:
perhaps:
cd $dest_dir
chmod 755 `find . -type d`
chmod 644 `find . -type f`
chown cvsuser:cvsuser `find`
is like what you need to do, but you need to decide that for your setup!\n\n";
}
sub spin {
return("\r", $SPIN[$SPIN >= 7 ? $SPIN=0 : ++$SPIN]);
# "Brandon, " you ask, "Why re-set $SPIN to '0' instead of using
# modulous?" "I don't know," I respond with a smirk, "to save
# memory?" Ahh, but really, the modulo operator uses divide and
# therefore can consume many more cycles than comparison
# (subtraction, usually). This would matter more in C.
}
# convert_all does the job of creating the new ',v' CVS files and
# of doing some translations including adding the tags (which is why
# we're in this mess in the first place!).
sub convert_all {
my %param = @_;
my $catalog = $param{'-catalog'};
my $src_dir = dirname($CONFIG{'src' });
my $dest_dir = $CONFIG{'dest'};
my $dot_date = join('.',map { sprintf("%02d",$_) } (localtime(time))[5,4,3,2,1,0]);
$dot_date =~ s/^(\d+)\./$1 + 1900 . '.'/e;
while (my($new_file,$hash) = each %{$catalog}) {
print &spin;
my $is_binary=0;
my (
$head ,
$versions,
);
my $file = &map_back($new_file);
open(my $reader, $file) || die "Can't open $file for reading: $!";
$new_file =~ s/^$src_dir/$dest_dir/o;
$new_file =~ s/$/,v/;
{
my $dir = dirname($new_file);
&mkdir_dash_p($dir) unless (-d $dir);
}
my $make_dead = 0;
my $dead_version;
unless ($hash && $hash->{'inHEAD'}) {
my @nf = fileparse($new_file);
$new_file = $nf[1].'Attic/'.$nf[0];
$make_dead = 1;
unless (-d "$nf[1]/Attic") {
mkdir("$nf[1]/Attic") || die "Can't create directory $nf[1]/Attic: $!";
}
}
open(my $writer, ">$new_file") || die "Can't open $new_file for writing--I have to exit.--I'm sorry\n";
HEAD_EXAMINE:
while (<$reader>) {
if (/^head\s+([.0-9]+)\s*;\s*$/) {
$head = $1;
if ($make_dead) {
my @v = split(/\./,$head);
$v[-1]++;
$dead_version = join('.',@v);
s/^(head\s+)[.0-9]+(\s*;)/$1$dead_version$2/;
}
}
next HEAD_EXAMINE if /^branch(es)?\s*;\s*$/;
s/^format\s+binary\s*;/expand \@b\@;/ && $is_binary++;
s/^comment\s*\@\@\s*;/comment \@# \@;/;
s/\%\d{1,2}/_/g;
# ^ convert any %\d{1,2} in TAGS to '_'
if (/^symbols/) {
print $writer "symbols";
if ($hash) { ## Add our tags.
foreach my $ver (reverse sort tag_cmp keys %{$hash->{'tags'}}) {
if (ref($hash->{'tags'}->{$ver}) eq 'ARRAY') {
foreach my $tag (reverse sort tag_cmp @{$hash->{'tags'}->{$ver}}) {
print $writer "\n\t$tag:$ver";
}
}
}
my $h = $dead_version || $head;
print $writer "\n\t$CONFIG{'cvs-sticky'}:$h" if $CONFIG{'cvs-sticky'};
print $writer "\n\t$CONFIG{'mks-sticky'}:$head" if $CONFIG{'mks-sticky'};
}
s/^symbols\s+//;
s/\s+/\n\t/g;
s/^([^;])/\n\t$1/;
s/\t$//;
print $writer $_; ## Print existing tags, and ';'
next HEAD_EXAMINE;
}
print $writer $_;
last HEAD_EXAMINE if /^\s*$/;
}
my $save_pos = tell($reader);
my $versions = &read_file_headers($reader, $head);
seek($reader, $save_pos, 0) || die "can't return to $save_pos"; # 0 == SEEK_SET
my $hit_desc_section=0;
#{
#my $current_version;
LOOK_EXT:
while (<$reader>) { ## get rid of 'ext' section, completely
if (/^ext\s*$/) {
last LOOK_EXT if /(?) {
last LOOK_EXT if /(?{'StateExp'}->{$current_version}) {
#s/; state \w+;/; state dead;/;
#}
if (/^desc/) {
$hit_desc_section = tell($reader) - length($_);
last LOOK_EXT;
}
print $writer $_;
# some files don't have 'ext' section
}
}
#}
if ($hit_desc_section) {
seek($reader,$hit_desc_section,0); # 0==SEEK_SET
}
if ($is_binary) {
# must convert patch from byte based to line based
my $start_position = tell($reader);
my %versions_info;
# pass one
while (<$reader>) {
next unless /^([.0-9]+)$/;
my $ver = $1;
while (<$reader>) {
last if /^text/;
}
my ($last,$first,$length,$lines);
my $a_or_d = 1;
while (<$reader>) {
next if $a_or_d && /^\@?[ad]\d+\s+\d+\s*$/;
$a_or_d-- if $a_or_d;
$first && $first-- && s/^\@//;
$last++ if /(?) {
unless (/^([.0-9]+)$/) {
print $writer $_;
next;
}
my $ver = $1;
my $parent_v = $versions_info{ $versions->{$ver}->{'parent'} };
my $my_v = $versions_info{ $ver };
if ($dead_version) {
my @save;
push(@save,$_);
print $writer "$dead_version\nlog\n\@Not in parent Project .pj, removed from CVS by mks2cvs\n\@\ntext\n";
while (<$reader>) {
push(@save,$_);
if (/^log/) {
while (<$reader>) {
s/^\@\@\s*$/\@ \@/; # get rid of empty logs which break "cvs co"
push(@save,$_);
last if /(?) {
print $writer $_;
next if $first_line && $first_line-- && /^\@$/;
last if /(?) {
print $writer $_;
if (/^log/) {
while (<$reader>) {
s/^\@\@\s*$/\@ \@/; # get rid of empty logs which break "cvs co"
print $writer $_;
last if /(?) {
if ($a_or_d && /^\@?([ad])(\d+)\s+(\d+)\s*$/) {
my ($sub_a_or_d, $start, $bytes) = ($1, $2, $3);
if ($sub_a_or_d eq 'd' && $start != 1) {
die "binary del not starting at '1'";
}
if ($sub_a_or_d eq 'd') {
s/^(\@)?d\d+\s+\d+/${1}d1 $parent_v->[0]/;
}
else {
s/^\@?a\d+\s+\d+/a$parent_v->[0] $my_v->[0]/;
}
print $writer $_;
next FIX_PATCH;
}
$a_or_d-- if $a_or_d;
print $writer $_;
next if $first_line && $first_line-- && /^\@$/;
last FIX_PATCH if /(?) {
print $writer $_;
if (/^desc/) {
my $first=1;
while (<$reader>) {
print $writer $_;
$first && $first-- && /^\@\@\s*$/ && last DESC_AREA;
last DESC_AREA if /(?) {
unless (/^[.0-9]+$/) {
print $writer $_;
next;
}
if ($dead_version) {
my @save;
push(@save,$_);
print $writer "$dead_version\nlog\n\@Not in parent Project .pj, removed from CVS by mks2cvs\n\@\ntext\n";
while (<$reader>) {
push(@save,$_);
if (/^log/) {
while (<$reader>) {
s/^\@\@\s*$/\@ \@/; # get rid of empty logs which break "cvs co"
push(@save,$_);
last if /(?) {
print $writer $_;
next if $first_line && $first_line-- && /^\@$/;
last if /(?) {
print $writer $_;
if (/^log/) {
my $first=1;
while (<$reader>) {
# get rid of empty logs which break "cvs co"
$first && $first-- && s/^\@\@/\@ \@/;
print $writer $_;
last if /(?) {
print $writer $_;
next if $first_line && $first_line-- && /^\@$/;
last if /(?{'v'}}) {
while (my($version, $parents) = each %{$branches}) {
for (my $i = 0; $i < $#{$parents}; $i+=2) {
push(
# into
@{$hash->{'tags'}->{$version}},
# with
&get_tags(
@{$parents}[$i, $i+1],
$catalog,
)
);
}
}
}
}
}
# get_tags recursively retrieves tag names from '.pj' parents and a CACHE.
sub get_tags {
# Sorry, this is very psychotic.
print &spin;
my $parent_n = shift;
my $parent_v = shift;
my $catalog = shift;
my %param = @_ ;
if (defined $TAGS_CACHE{$parent_n}{$parent_v} ) {
return @{$TAGS_CACHE{$parent_n}{$parent_v}};
}
my $version_for_tag = $parent_v;
$version_for_tag =~ s/\./_/g;
push
@{$TAGS_CACHE{$parent_n}{$parent_v}},
join('-',$catalog->{$parent_n}->{'bt'},$version_for_tag);
return @{$TAGS_CACHE{$parent_n}{$parent_v}}
unless $CONFIG{'inherit-tags'};
my @all_above =
map {
@{$_->{$parent_v}}
}
grep {
defined $_->{$parent_v}
}
values %{$catalog->{$parent_n}->{'v'}};
for (my $i = 0; $i < $#all_above; $i+=2) {
push
@{$TAGS_CACHE{$parent_n}{$parent_v}},
&get_tags(
@all_above[$i, $i+1],
$catalog
);
}
return @{$TAGS_CACHE{$parent_n}{$parent_v}};
}
sub map_back {
my $file = shift;
return defined $MAP_BACK{$file} ? $MAP_BACK{$file} : $file;
}
sub map_forward {
my $file = shift;
return defined $MAP_FORWARD{$file} ? $MAP_FORWARD{$file} : $file;
}
sub parse_pj {
my %param = @_;
print &spin;
my $catalog = $param{'-catalog'} ;
my $filepath = $param{'-pkg' } ;
my $base_tag = $param{'-basetag'} || '';
my (
$file,
$dir
) = fileparse($filepath);
my $orig_directory = dirname(&map_back($filepath));
$dir =~ s~$CONFIG{'dir-sep'}$~~;
$file =~ s/\.pj$//;
open(my $fh, &map_back($filepath)) || die "can't open file $file for reading: $!";
# I/emacs like/likes lots of indents, apparently. Easier to read? No
$catalog->{$filepath}->{'bt'}
=
$base_tag
=
$CONFIG{'top-tag-only'}
?
($base_tag || $file)
:
do {
my $t = join('-',$base_tag,$file);
$t=~s/^-//;
$t;
};
$catalog->{$filepath}->{'inHEAD'}++ unless $CONFIG{'past-top-pj'};
## Read in the version numbers and their branches.
my ($head, $versions) = &read_file_headers($fh);
my (
%children,
%patched ,
%files ,
);
# read in the head version and patches
while (<$fh>) {
next unless /^([.0-9]+)$/;
my $ver = $1;
1 while <$fh> !~ /^text\b/;
my $last;
while (<$fh>) {
# looking for an '@' to end a line
$last++ if /(?[0] =~ s/^\@//;
}
# this sub recursively creates (in memory) each version of this '.pj' file
# based on the head version and the patches.
# I think 'pp' means "patch parent" or something.
my $pp = sub {
my $pp = shift;
my $ver = shift;
my ($parent, $child, $branches) = ($versions->{$ver}->{'parent'},
$versions->{$ver}->{'child'},
$versions->{$ver}->{'branches'}
);
# create myself
if ($parent) {
unless($patched{$ver}++) {
@{$files{$ver}} = patch($files{$parent},$files{$ver});
}
}
$pp->($pp, $child) if ($child);
if ($branches) {
foreach my $branch (@{$branches}) {
$pp->($pp, $branch);
}
}
};
$pp->($pp, $head);
# look at each version of the '.pj' file (in memory) and extract
# references to other files.
LOOK_AT_FILES:
foreach my $ver (keys %files) {
push(@{$catalog->{$filepath}->{'tags'}->{$ver}},
$base_tag.'-'.do { my $t = $ver; $t=~ s/\./_/g; $t }
)
unless $CONFIG{'past-top-pj'};
for (@{$files{$ver}}) {
if (m~\$\(projectdir\)
((?:/[^/]+?)+(\"[^\"]+?=\")*) ## matches file name -> $1
\s+\w+\s+ ## intermediate character
((?:\d+)(?:\.\d+)+) ## the version of that file -> $3
\s*$~x)
{ #example# $(projectdir)/config/config.pj i 1.7
my ($f,$v) = ($1,$2); ## file, version
if ($f =~ /([^\"]*)\"([^\"]*)\"/) {
$f = $1.$2;
}
my $ff = $dir.$f;
my $branch = do {
$v =~ /(\d+\.\d+\.\d+)\./ ? $1
:
$ver =~ /(\d+\.\d+\.\d+)\./ ? $1 : 1;
};
unless (&check_for_files($ff)) {
if ($CONFIG{'fixcase'}) {
my $old = &winblows_fix_file_path('/',$orig_directory.$CONFIG{'dir-sep'}.$f);
if (&check_for_files($old)) {
$MAP_BACK{$ff}=$old;
my $orig_dir = dirname($old);
my $dirname_ff = dirname($ff);
$MAP_FORWARD{$orig_dir} = $dirname_ff unless defined $MAP_FORWARD{$orig_dir};
$MAP_FORWARD{$orig_dir.'/'} = $dirname_ff.'/' unless defined $MAP_FORWARD{$orig_dir.'/'};
}
else {
warn "$ff\n$old version $v is mentioned in $orig_directory/$file.pj version $ver but doesn't exist\n"
."I tried case fixing\n";
next LOOK_AT_FILES;
}
}
else {
warn "$ff version $v is mentioned in $filepath version $ver but doesn't exist\n"
."perhaps you should turn on case fixing '--fix-case'\n";
next LOOK_AT_FILES;
}
}
if ($ver eq $head && $catalog->{$filepath}->{'inHEAD'}) {
$catalog->{$ff}->{'inHEAD'}++;
# so, if this file's parent is in the HEAD, and if the version
# that we're looking at right now is HEAD, then it's in the HEAD.
}
#$catalog->{$ff}->{'StateExp'}->{$v}++;
push(@{$catalog->{$ff}->{'v'}->{$branch}->{$v}}, $filepath, $ver);
$children{$ff}++ if ($f =~ /\.pj$/);
}
}
}
$CONFIG{'past-top-pj'}++ if $CONFIG{'top-tag-only'};
# look at all '.pj' files mentioned by this '.pj' file
if ($CONFIG{'recurse'}) {
while (my($child,$refs) = each %children) {
parse_pj(-catalog => $catalog,
-pkg => $child,
-basetag => $base_tag,
);
}
}
close($file);
}
sub mkdir_dash_p {
my $dir = shift;
die "Dir \"$dir\" sucks\n" if $dir eq '';
die "Dir \"$dir\" sucks\n" if $dir eq $CONFIG{'dir-sep'};
my $parent = dirname($dir);
mkdir_dash_p($parent) unless -d $parent;
mkdir($dir) || die "Couldn't create dir \"$dir\": $!\n";
}
sub read_file_headers {
my $fh = shift ;
my $head = shift || '';
my %versions ;
unless ($head) {
# find the head marker (usually first line)
while (<$fh>) {
next unless /^head\s+([.0-9]+)\s*;\s*$/;
# next unless /^head\s+((?:\d+)(?:\.\d+)+)\s*;\s*$/;
$head = $1;
last;
}
}
# read in the versions and 'next' and 'branches'
while (<$fh>) {
last if /^ext/;
next unless /^((?:\d+)(?:\.\d+)+)\s*/;
my $ver = $1;
local $/ = "\n\n";
local $_ = <$fh>;
my $branches = join('',/branches((?:\s+[.0-9]+\b)+)\s*\;/);
$branches =~ s/\s+/ /mg;
$branches =~ s/^\s+//;
foreach my $branch (split(/ /,$branches)) {
$versions{$branch}->{'parent'} = $ver;
push(@{$versions{$ver}->{'branches'}}, $branch);
}
if (/next\s+([.0-9]+)\s*;/) {
$versions{$1}->{'parent'} = $ver;
$versions{$ver}->{'child'} = $1;
}
}
return ($head, \%versions);
}
sub check_for_files {
if (wantarray) {
my @r;
for (@_) {
push(@r, defined $FILE_CHECK_CACHE{$_} ? $FILE_CHECK_CACHE{$_} : $FILE_CHECK_CACHE{$_} = -e);
}
return @r;
}
else {
for ($_[0]) {
return defined $FILE_CHECK_CACHE{$_} ? $FILE_CHECK_CACHE{$_} : $FILE_CHECK_CACHE{$_} = -e;
}
}
}
sub winblows_fix_file_path {
# this function takes base_dir which is assumed to be the correct
# cAsE spelling. It then looks through xtra_dir (which would be
# appended to base dir like: base_dir/xtra_dir or /foo/bar) to
# fix any misspellings based on case. If /foo/bar exists, but
# $xtra_dir contains = '/foo/BAr' it will fix that.
my $base_dir = shift;
my $xtra_dir = shift;
my ($pre ,
$post,
) = ('')x2;
my $sep = $CONFIG{'dir-sep'};
unless (-d $base_dir) {
warn "you passed me $base_dir as a base dir, and it doesn't exist. returning";
return $xtra_dir;
}
my @fields = do {
local $_ = $xtra_dir;
s/$sep+/$sep/g;
$pre = $1 if s/^($sep)//;
$post = $1 if s/($sep)$//;
split $sep;
};
foreach my $i (0 .. $#fields) {
next if -d join($sep,$base_dir,@fields[0..$i]);
my $d = $i ## first one last one is not one
?
join($sep,$base_dir,@fields[0..$i-1])
:
$base_dir;
my $search = "\L$fields[$i]";
opendir(my $dir, $d) || do {
warn "something tragic: $d should be a dir, but I can't open it: $!";
return $xtra_dir;
};
my @match = grep { "\L$_" eq $search } readdir($dir);
closedir($dir);
if (@match) {
if ($#match) {
warn "eeek. I found more than one cAsE spelling of $fields[$1]
in $d. They are: ".join("\n",@match)."\nreturning";
return $xtra_dir;
}
else {
# only found one match, so replace it.
$fields[$i] = $match[0];
}
}
else {
warn "eeek. I couldn't find $fields[$1]
in $d. returning";
return $xtra_dir;
}
}
return $pre.join($sep,@fields).$post;
}
sub find_un_mentioned_files_find_dirs {
my %param = @_;
my $catalog = $param{'-catalog'};
my $sep = $CONFIG{'dir-sep' };
my (
@all_dirs ,
%dir_cache,
%checked ,
%un ,
);
my $look = sub {
my $look = shift;
my $dir = shift;
return if $dir_cache{$dir}++;
push @all_dirs, $dir;
my @dirs;
local $_;
chdir($dir) || do {
warn "Can't cd to $dir";
chdir($CONFIG{'src'});
return;
};
opendir(my $dirh,$dir) || do {
warn "Can't open $dir: $!";
chdir($CONFIG{'src'});
return;
};
my @readdir = readdir($dirh);
closedir($dirh);
# probably better to close it sooner and use some memory
# than to have tons of open dirs.
for (@readdir) {
print &spin;
next if /^\.{1,2}/;
next if -l;
if (-d) {
push @dirs, $_;
}
else {
my $d = &map_forward($dir);
$un{$d.$_}++ unless defined $catalog->{$d.$_};
}
}
for (@dirs) {
$look->($look,$dir.$_.'/');
}
closedir($dirh);
};
$look->($look,$param{'-top'}.'/');
print "\r \ncheck 2. Why you ask? I don't know. Just in case, I guess\n";
# # Only using the check method below since it uses the directory names
# # that are referenced in the .pj files.
while (my($file,$hash) = each %{$catalog}) {
print &spin;
my ($f, $dir) = fileparse($file);
my $real_dir = (fileparse(&map_back($file)))[1];
next if $dir_cache{$dir}++;
if ($real_dir ne $dir) {
next if $dir_cache{$real_dir}++;
}
opendir(my $dirh, $real_dir) || do {
warn "Couldn't open $real_dir because: $!";
return;
};
foreach my $file (grep { ! $checked{$_}++ } readdir($dirh)) {
my $check = join('',$dir,$file);
next if -d $real_dir.$file;
$un{$check}++ unless defined $catalog->{$check};
}
}
return(\@all_dirs, keys %un);
}
sub patch {
my @file = @{shift()};
my $patch = shift;
unless (ref($patch) eq 'ARRAY') {
return @file;
}
shift(@{$patch}) while (
scalar @{$patch}
&&
$patch->[0] !~ /^[ad]\d+\s+\d+\s*$/
);
my $ix;
my $comp=-1;
for (@{$patch}) {
if (my($ad,$where,$much) = /^([ad])(\d+)\s+(\d+)\s*$/) {
if ($ad eq 'd') {
splice(
@file,
$where + $comp,
$much,
(undef()) x $much
);
}
elsif ($ad eq 'a') {
$ix = $where + $comp + 1;
$comp += $much;
}
}
else {
splice(@file, $ix++, 0, $_);
}
}
return grep { defined $_ } @file;
}
sub tag_cmp {
return 0 unless $a cmp $b;
my @a = split(/(\D)/,$a);
my @b = split(/(\D)/,$b);
my $x = $#a > $#b ? $#b : $#a;
my $cmp;
foreach my $i (0 .. $x) {
$cmp = $a[$i] =~ /^\d+$/ && $b[$i] =~ /^\d+$/ ? $a[$i] <=> $b[$i] : $a[$i] cmp $b[$i];
return $cmp if $cmp;
}
return $#a <=> $#b;
}
__END__
=head1 NAME
mks2cvs - convert an MKS thingy to a CVS type thingy
=head1 SYNOPSIS
mks2cvs --src=/nt/Source/foo.pj --dest=/cvsroot/foo/
=head1 REQUIREMENTS
read BUGS (B<<--really!>)
File::Basename
perl5.6.0
I've required perl5.6.0 for the wonderful feature of
autovivified handles. Please don't get mad.
If you remove autovivified filehandles, you'd need perl5.004_04;
but hey, if you are going to spend
the time hacking this code to make it work on old perl,
why not upgrade your perl to 5.6! It really is worth it!
(Actually, I'm figuring most people porting to CVS are
using a new CVS server with new perl; I hope I'm right)
I can't remember what version added zero-width negative
look behind in regex, but you need that too.
=head1 OVERVIEW
The top level '.pj' file that you specify (src) is read as are all '.pj'
files mentioned by 'src' and all children (and so on). Every
file that is mentioned in each '.pj' (including the .pj files)
is cataloged. The catalog links every file's version to a version
of it's owning '.pj' file. Each version of each '.pj' file gets
a tag. When the CVS files are created, the tags are applied
to the new files: thus retaining the MKS sillyness. A '.pj'
file inherits its '.pj' file's tag unless you say not to
(--inherit-tags=off) in addition to its own specific tag
(if you only want the top tag say --top-tag-only=on).
So something like:
foo.pj
bar/bar.pj
bar/zam/zam.pj
Would generate tags like:
foo-1_0 foo-1_1 foo-bar-1_0 foo-bar-1_1 foo-bar-1_2
foo-bar-zam-1_0 foo-bar-zam-1_1
Currently there is no way to change the names of the tags
as I didn't see or have a need.
This program also performs some small conversions:
=over 4
=item *
C
is changed to
C
=item *
C
is removed.
=back
=head1 UNDERVIEW
MKS uses an RCS based file with a couple of small
differences. It is trivial to "import" these files
into a CVS system; actually, all you need to do
is copy them, and do some small mods.
Something like this would probably work...
(B, use my program!)
Copy the files:
cd /nt-mount/my-mks-archive
find . -depth -print0 | cpio --null -pvd /cvsroot/some/empty/dir
cd /cvsroot/some/empty/dir
Make the permissions right if you need to:
chmod 755 `find . -type d`
chmod 644 `find . -type f`
Rename them to have a ',v' at the end.
for n in `find . -type f`; do mv $n $n,v; done
Convert some stuff:
perl -pi -e '$/=undef;
s/\bext\n(?:.+\n)*\n//;
s/\nformat binary\s*\n;/\nexpand \@b\@;\n/;' `find . -type f`
Now you I have your data store in a CVS repository, and
see the history of the files, but I how they were related to each other. Also, binary files
are stored using a character position diff in MKS instead of
RCS's/CVS's standard line number diff for all files. And
nothing that should be in Attic/ would be. And if there were
some CaSe differences between Filesystem files and .pj references
that would be broken.
This tool (mks2cvs) translates the MKS "Project"
mentality of tracking files' relationships to each
other into CVS TAGS. Yippie.
=head1 DO IT
First get your MKS store onto the same machine that
you are going to run this program (and where the
CVS files will be generated); NFS mount them if you need
to.
Create an empty directory to put your new files in. (If you
use the included mks2cvs-top-level script [see --help] it
creates the destination directories for you)
Look below at USAGE.
=head1 USAGE
mks2cvs --src=/nt/Source/foo.pj --dest=/cvsroot/foo/
(please see 'perldoc mks2cvs' for more info)
--script=script-alias
extracts usefull shell scripts to help you with conversion
(--script=all) and to help check CVS files after
the conversion (--script=verify). See mks2cvs --script
for more details.
--src=/some/path/to/file.pj
This is the source "MKS Project" file that we are going
to convert to CVS.
--dest=/some/path/to/destination/
This is an empty directory where we will deposit the
converted MKS files as full blown CVS files.
--fix-case
Pretend that you are accessing source files via a
pathetic file system such as FAT or ntfs
that does not recognize "cAsE" differences. If it
still can't find your file, or it finds multiple
matches while performing the translation... sorry.
The case used in the .pj file is the case used in CVS.
--dir-sep=value
Change the directory seperator from the default '/'
to that of your system. This is completely un-tested. :-)
--inherit-tags=[on|off]
All child projects should inherit the tags of their parents.
Default is --inherit-tags=on.
--top-tag-only=[on|off]
Children should not get their own tags, only the tags
for the very top parent. This overrides --inherit-tags=off.
Default is -top-tag-only=off.
--mks-sticky=SOME_TAG
All files (even those placed in the Attic) will be tagged
with this tag in the HEAD version in the version that existed
before mks2cvs moved them to the Attic (if it did)
The default behavior is '--mks-sticky=MKS_IMPORT'.
You can turn it off with --mks-sticky=''. I say leave it on.
So, if you check out with this tag, you will get all files.
It is not a super usefull tag, and if it annoys you, remove
is with "cvs rtag -d MKS_IMPORT /foo", and see next option.
--cvs-sticky=SOME_TAG
All files (even those placed in the Attic) will be tagged
with this tag in the HEAD version; they will be PROPERLY considered
deleted if they were moved to the Attic. The default behavior
is '--cvs-sticky=CVS_START'. You can turn it off with
--cvs-sticky=''. I say leave it on.
So, if you check out with this tag, you will get all files
that are not in the Attic after conversion.
=head1 BUGS
This program I support MKS versions up to B 7.6
(discovered by J.B. Yang). I (or someone like me) could make it work
with 7.6, if properly motivated; I do not have access to _ANY_ version
of MKS at this point in time.
There is no simple way of changing state to dead for files that are removed
from an MKS .pj for some time. This is becuase when CVS "removes" a
file, it is (1) incremented in version, (2) state changed to dead,
and (3)moved to the Attic. The hard part for me would be properly
incrementing the version; it doesn't seem like a worthwhile exersize
considering the large possibility for trouble that it could cause.
I have decided to simply move the file to Attic if it doesn't exist
in its parent's final .pj version. When checking out older versions
based on tags, CVS will act as you expect anyway (by leaving out
files that aren't tagged with the associated tag).
There is a big difference between the way MKS stores diffs for binary
files, and the way RCS and CVS does. This converter does it's best
to convert them but it does not yet optimize the diffs the way that
CVS does. There is also a chance that the conversion will not work
properly. If this happens you will may not be able to properly retrieve
older versions of any file that failed. This possibility exists
because this program assumes that each diff will contain one diff only,
and that each diff is just a replacement of the entire file in
question (hence why CVS and RCS are more effecient regarding space).
If any of the tags I generate already exists in a file (which
doesn't seem too likely) there will be two of the same tag
and you'd have to fix that by hand.
MKS uses %20 type url encoding in tag names which I don't really care
about, I convert any %\d{1,2} to a '_'
=head1 RANTS
I hate branches.
=head1 STYLE
Some say Perl is ugly. Some say Perl is beautiful.
Sometimes Some is I. One or the other Some think.
Some have tried to make sure this code proves that both
are true; Some hope Some have succeeded. If ever there
was code that could prove either; Some say this is it.
=head1 AUTHOR
"Brandon L. Golm"
Contributions from: Ronald Landheer-Cieslak, and
J.B. Yang (discovered MKS 7.6 incompatibility--not fixed).
Please feel free to contact me with questions or problems. If you do,
be sure to tell me what version of MKS you are using (so that
I can make a record of problems with different versions).
=head1 SCRIPT CATEGORIES
Unix/System_administration
=head1 SEE ALSO
cvs, cvsls (coming soon)
=head1 README
Converts a MKS based source repository to a CVS based respository
and converts MKS's notion of "versioning" (of each Project [.pj])
to obvious matching tags containing the same version numbers.
Contains some self-extracting helper shell-scripts.
=cut
VERIFY-ALL-CVS
#!/bin/sh
# verify-all-cvs uses rlog to check for errors in
# CVS files "*,v" that might occur after traslating from MKS
# usage: verify-all-cvs /path/to/files/
# Copyright (c) 2001 "Brandon L. Golm"
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify it
# with mks2cvs under the same terms as Perl itself provided this message and author
# information is retained.
P=$1
if [ "X$P" == "X" ]; then
echo "usage: $0 /some/path/"
exit;
fi
if [ ! -d $P ]; then
echo "$P is not a directory"
exit;
fi
echo -n "generating list of files"
mess=1
first=1
for n in `find $P -name "*,v" -print`
do
if [ $mess -eq 1 ]; then echo -en "\rusing rlog to check for errors"; mess=0; fi
rlog $n >/dev/null 2>&1
if [ $? -ne 0 ]; then
if [ $first -eq 1 ]; then echo -e "\rerrors found in: "; first=0; fi
echo $n
fi
done
if [ $first -eq 1 ]; then echo -e "\rno errors found "; fi
echo
echo
echo "I recommend doing the following to verify further.
Check out the entire store that you just created
tag the entire tree with some tag:
cvs tag CVS-TEST-TAG
then delete that tag
cvs tag -d CVS-TEST-TAG
then update to version 1.1 of all files
cvs update -r 1.1 *
then revert to HEAD
cvs update -A
Hopefully this will ensure that you can read all files."
echo
VERIFY-ALL-CVS
MKS2CVS-ALL-TOP-LEVEL
#!/bin/sh
#!/bin/ksh
# I think this will work in ksh, but only tested bash
# mks2cvs-toplevel finds top level MKS Project files
# and runs mks2cvs to convert them each to CVS.
# You can use it to create directories that don't
# exist yet, which makes it painless to use.
# you'll probably need to change the path below.
MKS2CVS="MKS2CVS-PROGRAM"
if [ ! -f $MKS2CVS ]; then
echo "you need to set MKS2CVS in this file $0, $MKS2CVS doesn't exist"
exit;
fi
# Copyright (c) 2001 "Brandon L. Golm"
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify it
# with mks2cvs under the same terms as Perl itself provided this message and author
# information is retained.
SAVEPWD=$PWD
TOP=$1
cd $TOP
if [ $? -ne 0 ]; then
exit
fi
NEW_ROOT=$2
function usage {
echo "usage: $0 /path/to/sources /path/to/cvs/dest [opts to mks2cvs]"
}
if [ "X$NEW_ROOT" == "X" ]; then
echo "must specify destination"
usage
exit
fi
if [ "X$4" != "X" ]; then
echo "specify more options to mks2cvs with quotes: $0 /path1 /path2 '-opt1 -opt2'"
usage
exit
fi
OPTS=$3
bigi=0
NEW_TOP="."
function find_pj_in {
for top in `find $NEW_TOP -maxdepth 1 -mindepth 1`
do
i=0
unset tmp
for n in `find $top -maxdepth 1 -name "*.pj"`
do
tmp[i++]=$n
done
if [ ${#tmp[*]} -eq 1 ]; then
if [ $n == $top ]; then
unset all
all[0]=''
all[1]=$n
return
else
all[bigi++]=$top
all[bigi++]=${tmp[0]}
fi
elif [ ${#tmp[*]} -eq 0 ]; then
NEW_TOP=$top
find_pj_in
else
echo "found many in $top!!"
echo "found many in $top!!" >&2
all[bigi++]=$top
all[bigi++]=${tmp[0]}
fi
done
}
find_pj_in
# ${all[*]}
cd $SAVEPWD
echo "here's the list of packages"
echo
i=1
while [ $i -lt ${#all[*]} ]; do
echo "$TOP/${all[$i]}"
let i=$i+2
done
echo
echo -n "Do you want to convert them all? (y|n) "
read ANS
if [ "X$ANS" != "Xy" ]; then
echo "You answered no"
exit
fi
i=0
while [ $i -lt ${#all[*]} ]; do
echo "Creating destination directory"
cmd="mkdir -p ${NEW_ROOT}/${all[$i]}"
echo $cmd
$cmd
echo "******************************"
echo "***** RUNNING mks2cvs ********"
echo "******************************"
cmd="$MKS2CVS --src=$TOP/${all[$i+1]} --dst=${NEW_ROOT}/${all[$i]} $OPTS"
echo $cmd
echo
$cmd
if [ $? -ne 0 ]; then
echo "Command failed"
exit;
fi
let i=i+2
done
MKS2CVS-ALL-TOP-LEVEL