#!/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