- eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
- & eval 'exec perl -S $0 $argv:q'
- if 0;
- # THE PRECEEDING STUFF EXECS perl via $PATH
- # -*-Fundamental-*-
- # $Id: //guest/naveen_patil/perforce/utils/cvs2p4/bin/genmetadata#5 $
- #
- # Richard Geiger
- #
- require 5.000;
- require "timelocal.pl";
- use bytes;
- my %Files_seen;
- sub dirname
- {
- local($dir) = @_;
- $dir =~ s%^$%.%; $dir = "$dir/";
- if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
- if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
- { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
- return ".";
- }
- use Carp; # ...or flounder. (This will fail unless 'perl' is a perl5!)
- $| = 1;
- ($Myname = $0) =~ s%^.*/%%;
- $Mydir = &dirname($0);
- $Here = `/bin/pwd`; chop $Here;
- if ($Mydir ne ".") { chdir "$Mydir" || die "$Myname: can't chdir \"$Mydir\": $!"; }
- chdir ".." || die "$Myname: can't chdir \"..\": $!";
- $Mydir = `/bin/pwd`; chop $Mydir;
- chdir $Here || die "$Myname: can't chdir \"$Here\": $!";
- require "$Mydir/lib/util.pl";
- $Usage = <<LIT;
- $Myname: usage: $Myname
- LIT
- sub usage
- {
- print STDERR $Usage;
- exit 1;
- }
- sub help
- {
- print STDERR <<LIT;
- $Usage
- $Myname is not done yet. Be patient.
- LIT
- exit 1;
- }
- ######
- #
- # Perlstuff for parsing RCS repository files
- #
- # Some globals used by these routines...
- #
- $Rcs_Inquote = 0; # remembers when we're in a '@' quoted string
- $Rcs_Eofatal = 1; # die if we hit the end of the file
- $Rcs_File = "?"; # caller should set this for the error message
- sub lead
- { if (defined($Myname)) { return "$Myname: "; } else { return ""; } }
- sub rcsline
- {
- my $line;
- my $m;
- $line = <RCS>;
- if ($line eq "")
- {
- if ($Rcs_Eofatal)
- {
- $m = "unexpected eof on \"$Rcs_File\".";
- printf STDERR "%s$m\n", &lead();
- exit 1;
- }
- else
- { return undef; }
- }
- if ($line =~ /\r{0,1}\n$/) { $line =~ s/\r{0,1}\n$//; }
- return $line;
- }
- $Rcstok_Buf = "";
- $Rcstok_pushed = undef;
- # Return the next token from the RCS repository file.
- # Caller should open the file on descriptor RCS.
- # (Caller should also empty $Rcstok_Buf!)
- sub rcstok
- {
- my $rcsstr;
- my $m;
- my $strpart;
- if (defined($Rcstok_pushed))
- {
- my $ret = $Rcstok_pushed;
- $Rcstok_pushed = undef;
- return $ret;
- }
- $Rcstok_Buf =~ s/^\s+//;
- if ($Rcstok_Buf eq "")
- {
- while (1)
- {
- $Rcstok_Buf = &rcsline();
- if (! defined ($Rcstok_Buf)) { return undef; }
- if ($Rcstok_Buf ne "") { last; }
- }
- $Rcstok_Buf =~ s/^\s+//;
- }
- # : ; id
- #
- # Note: the character class for "idchar" assumes all characters
- # are printable ascii! May break with binary RCS files.
- # (Actually, I've now convinced myself that there is no
- # concern here).
- #
- if ($Rcstok_Buf =~ /^(:|;|[0-9.]*[^ \t\r\n$,.:;@]+)(.*)$/)
- { $Rcstok_Buf = $2; return $1; }
- # num
- #
- if ($Rcstok_Buf =~ /^([0-9][0-9.]*)(.*)$/)
- { $Rcstok_Buf = $2; return $1; }
- # string
- #
- if ($Rcstok_Buf =~ /^@(.*)$/)
- {
- $Rcstok_Buf = $1;
- $rcsstr = "";
- while (1)
- {
- if ($Rcstok_Buf eq "")
- {
- $rcsstr .= "\n";
- $Rcstok_Buf = &rcsline();
- if (! defined ($Rcstok_Buf)) { return undef; }
- }
- if ($Rcstok_Buf =~ /^(.*[^@])@([^@].*)$/)
- {
- my $tmp = $1;
- $Rcstok_Buf = $2;
- $tmp =~ s/\@\@/\@/g;
- $rcsstr .= $tmp;
- return $rcsstr;
- }
- if ($Rcstok_Buf =~ /^.*\@\@$/)
- {
- # check for multiple @s at the end - have to look for odd number
- $Rcstok_Buf =~ /^(.*[^@])(\@+)$/;
- my $tmp = $1;
- $Rcstok_Buf = $2;
- $tmp =~ s/\@\@/\@/g;
- $rcsstr .= $tmp;
- my $odd = length($Rcstok_Buf) % 2;
- if ($odd)
- {
- $Rcstok_Buf = substr($Rcstok_Buf, 1);
- }
- $Rcstok_Buf =~ s/\@\@/\@/g;
- $rcsstr .= $Rcstok_Buf;
- $Rcstok_Buf = "";
- if ($odd)
- {
- return $rcsstr;
- }
- }
- if ($Rcstok_Buf =~ /^(.*)\@$/)
- {
- my $tmp = $1;
- $Rcstok_Buf = "";
- $tmp =~ s/\@\@/\@/g;
- $rcsstr .= $tmp;
- return $rcsstr;
- }
- if ($Rcstok_Buf =~ /^\@([^@].*)$/)
- {
- $Rcstok_Buf = $1;
- return $rcsstr;
- }
- if ($Rcstok_Buf =~ /^\@$/)
- {
- $Rcstok_Buf = "";
- return $rcsstr;
- }
- $Rcstok_Buf =~ s/\@\@/\@/g;
- $rcsstr .= $Rcstok_Buf;
- $Rcstok_Buf = "";
- }
- }
- $m = "rcstok(): internal error: \$Rcstok_Buf <$Rcstok_Buf>";
- printf STDERR "%s$m\n", &lead();
- exit 1;
- }
- sub dirname
- {
- my ($dir) = @_;
- $dir =~ s%^$%.%; $dir = "$dir/";
- if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
- if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
- { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
- return ".";
- }
- sub skip_to_rcstok
- {
- my ($this) = @_;
- my $tok;
- while (($tok = &rcstok()) ne $this) { };
- }
- sub skip_to_deltas
- {
- my $tok;
- # Called after we encounter ";" for symbols. We must now skip:
- #
- # locks {id : num}*; {strict ;}
- # { comment {string}; }
- # { expand {string}; }
- # { newphrase }*
- while (1)
- {
- my $fatalsave = $Rcs_eofatal;
- $tok = &rcstok();
- if ($tok eq "expand")
- {
- $RCS_expand = &rcstok();
- if (&rcstok() ne ";")
- { die "$Myname: skip_to_deltas(): expected ';' after expand."; }
- next;
- }
- if ($tok =~ /^[0-9]/) { $Rcstok_pushed = $tok; last; }
- while (1)
- {
- # Turning this off here because it looks like cvs problems can create
- # delta-less ,v files; this allows us to handle this.
- #
- $Rcs_Eofatal = 0;
- $tok = &rcstok();
- $Rcs_Eofatal = $fatalsave;
- if (! defined($tok)) { return undef; }
- if ($tok eq ";") { last; }
- }
- }
- return 1;
- }
- sub test_rcstoks
- {
- my $tok;
- open(RCS, "<$ARGV[1]") || die;
- $Rcstok_Buf = "";
- $Rcs_Eofatal = 0;
- while (defined($tok = &rcstok))
- { print "<$tok>\n"; }
- exit 1;
- }
- sub setrevs
- {
- my($d_rev, $d_next, $d_branches, $d_date, $d_author, $d_state) = @_;
- my($b_rev);
- $RCS_Revs{$d_rev} = "$d_next:$d_branches";
- $d_date = "19$d_date" if length(( split( /\./, $d_date ))[0]) < 4;
- $RCS_Dates{$d_rev} = "$d_date";
- $RCS_Authors{$d_rev} = "$d_author";
- $RCS_States{$d_rev} = "$d_state";
- if ($d_rev =~ /^1\.1\.1(\.[0-9]+)?$/)
- {
- # We have a "vendor" branch - spoof a branch tag for it.
- #
- my $import_branch = "import";
- if ($PureRCS) { $import_branch = "1.1.1"; }
- $RCS_Branchtags{$import_branch} = "1.1.0.1";
- $RCS_Tags{$import_branch} = "1.1.0.1";
- }
- if ($d_rev =~ /^[0-9]+\.[0-9]+$/)
- {
- $RCS_Prevs{$d_rev} = $d_next;
- if ($d_next) { $RCS_Nexts{$d_next} = $d_rev; }
- }
- else
- {
- if ($d_next) { $RCS_Prevs{$d_next} = $d_rev; }
- $RCS_Nexts{$d_rev} = $d_next;
- }
- foreach $b_rev (split(/ /, $d_branches))
- { $RCS_Prevs{$b_rev} = $d_rev; }
- }
- # initialize RCS_Tags, RCS_Revs, (etc.) from an RCS ,v file.
- #
- sub set_RCS_revs
- {
- my ($path, $do_texts) = @_;
- my $repfile;
- my $tag;
- my $rev;
- my $tok;
- my ($d_havedelta, $d_branches, $d_next, $d_rev);
- my ($ext, $format);
- my $rcspath;
- my $msg;
- undef $RCS_Valid;
- undef $RCS_expand;
- undef $RCS_exec;
- undef %RCS_Tags;
- undef %RCS_Branchtags;
- undef %RCS_Revs;
- undef %RCS_States;
- undef %RCS_Authors;
- undef %RCS_Dates;
- undef %RCS_Prevs;
- undef %RCS_Nexts;
- undef $RCS_Branch;
- undef %RCS_Texts;
- undef $RCS_import_is_main;
- ($Rcs_File = $path) =~ s%^.*/%%;
- $repfile = $path;
- $rcspath = "<$repfile";
- if (! open(RCS, $rcspath))
- {
- printf STDERR "%scan't open \"$rcspath\": $!\n", &lead();
- return 0;
- }
- if (-x $repfile) { $RCS_exec = "x"; }
- $Rcstok_Buf = "";
- # DEBUG # while (1) { $tok = &rcstok(); print "<$tok>\n"; }
- &skip_to_rcstok("head");
- $RCS_Tags{"head"} = &rcstok();
- $tok = &rcstok(); $tok = &rcstok();
- if ($tok eq "branch") { $RCS_Branch = &rcstok(); }
- if ($RCS_Branch eq "1.1.1") { $RCS_import_is_main = 1; }
- &skip_to_rcstok("symbols");
- while (1)
- {
- $tok = &rcstok();
- if ($tok eq ";") { last; }
- $tag = $tok; &rcstok(); $rev = &rcstok();
- if (($cnt = $rev =~ tr/\./\./) % 2 == 0)
- {
- if ($rev ne "1.1.1") # 'cause we call it "import"!
- {
- # Handle "RCS" branch tags:
- #
- my @nums = split(/\./, $rev);
- splice @nums, $#nums, 0, (0);
- $rev = join(".", @nums);
- }
- }
- $RCS_Tags{$tag} = $rev;
- if ((! $PureRCS) && $rev =~ /\.0\.[0-9]+$/)
- { $RCS_Branchtags{$tag} = $rev; }
- elsif (($cnt = $rev =~ tr/\./\./) % 2 == 1)
- {
- ($reppath = $repfile) =~ s/,v$//;
- if (! defined($RCS_Revtags{$tag}))
- { $RCS_Revtags{$tag} = [ ] ; }
- if ($IMPORTTAGSPOOF && $rev eq "1.1.1.1") { $rev = "1.1"; }
- push(@{$RCS_Revtags{$tag}}, "$reppath/$rev");
- }
- }
- if (&skip_to_deltas() == undef) { return undef; }
- $d_rev = ""; $d_havedelta = 0; $d_branches = ""; $d_next = "";
- while (1)
- {
- $tok = &rcstok();
- if ($tok =~ /^[0-9.]+$/)
- {
- if ($d_havedelta)
- { &setrevs($d_rev, $d_next, $d_branches, $d_date, $d_author, $d_state); }
- $d_rev = $tok; $d_havedelta = 1; $d_branches = ""; $d_next = "";
- }
- elsif ($tok eq "branches")
- {
- while (1)
- {
- if (($tok = &rcstok()) eq ";") { last; }
- if ($PureRCS)
- {
- my ($l, $b, $r) = ($tok =~ /(.*)\.(\d+)\.(\d+)$/);
- my $tag = "$l.$b";
- $RCS_Branchtags{$tag} = $rev;
- }
- if ($d_branches ne "") { $d_branches .= " "; }
- $d_branches .= $tok;
- }
- }
- elsif ($tok eq "date") { $tok = &rcstok(); if ($tok ne ";") { $d_date = $tok; &rcstok(); } }
- elsif ($tok eq "author") { $tok = &rcstok(); if ($tok ne ";") { $d_author = $tok; &rcstok(); } }
- elsif ($tok eq "state") { $tok = &rcstok(); if ($tok ne ";") { $d_state = $tok; &rcstok(); } }
- elsif ($tok eq "next") { $tok = &rcstok(); if ($tok ne ";") { $d_next = $tok; &rcstok(); } }
- # Note: "format" and "ext" seem to be extentions used by MKS
- # Source Integrity. They don't show up in my rcsfile(5) man
- # page!
- elsif ($tok eq "format") { $tok = &rcstok(); if ($tok ne ";") { $format = $tok; &rcstok(); } }
- elsif ($tok eq "ext") { $tok = &rcstok(); $ext = $tok; }
- elsif ($tok eq "desc") { last; }
- else { &skip_to_rcstok(";"); }
- }
- if ($d_havedelta)
- { &setrevs($d_rev, $d_next, $d_branches, $d_date, $d_author, $d_state); }
- if (! defined($do_texts)) { close RCS; $RCS_Valid = 1; return 1; }
- $Rcs_Eofatal = 0;
- while (1)
- {
- $tok = &rcstok();
- if (! defined($tok)) { last; }
- if ($tok =~ /[0-9.]+/)
- { $d_rev = $tok; }
- elsif ($tok eq "text")
- {
- $msg = &rcstok();
- if ($msg eq "") { $RCS_Texts{$d_rev} = 0; } else { $RCS_Texts{$d_rev} = 1; }
- }
- elsif ($tok eq "log")
- { $log = &rcstok(); $RCS_Logs{$d_rev} = $log; }
- }
- $Rcs_Eofatal = 1;
- close RCS;
- $RCS_Valid = 1;
- return 1;
- }
- sub rcs_tip
- {
- my ($rev) = @_;
- my $next;
- # Find the tip of the branch...
- #
- while (1)
- {
- if (! defined($RCS_Revs{$rev}))
- { return "???"; }
- ($next) = split(/:/, $RCS_Revs{$rev});
- if ($next eq "") { return $rev; }
- $rev = $next;
- }
- }
- # given a "CVS line spec" (revision #, "head", or a tag)
- #
- sub rev_on_line
- {
- my($line) = @_;
- if ($line eq $TRUNKLINE)
- { $line = "head"; }
- # else
- # { $line = "${line}_BRANCH"; }
- if (defined($RCS_Tags{$line})) { $line = $RCS_Tags{$line}; }
- elsif ($line !~ /^[0-9.]+$/) { return "none"; }
- if ($line =~ /\.0\.([0-9]+)$/)
- {
- # It's a CVS branch revision number... demunge it:
- #
- $line =~ s/\.0(\.[0-9]+)$/$1/;
- # OK, see whether the branch actually exists:
- # (We have an assumption here that first rev is always ".1")
- #
- $line = "$line.1";
- if (! defined($RCS_Revs{$line}))
- {
- # Nope, so fall back to the root, which we know to be an
- # existing revision...
- $line =~ s/\.[0-9]+\.[0-9]+$//;
- return $line;
- }
- # Yep, the branch exists; so it *is* a branch; so, we go out to
- # the tip. (Right?)
- #
- return &rcs_tip($line);
- }
- # OK, do we have an RCS branch or an RCS revision number? (count
- # the dots)
- #
- if (($line =~ tr/\././) % 2)
- {
- # An odd number of dots... it's a revision number
- #
- if (defined($RCS_Revs{$line})) { return $line; }
- return "none"; # Or should we assert?
- }
- else
- {
- # An even number of dots... it's a branch number
- # (We have an assumption here that first rev is always ".1")
- #
- return &rcs_tip("$line.1");
- }
- }
- # Is rev "$this" < rev "$that"?
- # Note: "" is considered infinitely high
- # revs must be of the same order (I.e., same # of "."s)
- #
- sub rev_lt
- {
- my($this, $that) = @_;
- my(@this, @that);
- if (! $that) { return 1; }
- @this = split(/\./, $this);
- @that = split(/\./, $that);
- while (1)
- {
- $this_n = shift(@this);
- $that_n = shift(@that);
- if ($this_n < $that_n) { return 1; }
- if ($this_n > $that_n) { return 0; }
- if ($#this < 0) { return 0; }
- }
- }
- # Note: "" is considered infinitely high
- #
- sub linerev_gt
- {
- my($this, $that) = @_;
- my $ret;
- if (! $that)
- { $ret = 1; }
- else
- {
- my $thisord, $thatord;
- $thisord = ($this =~ tr/\././);
- $thatord = ($that =~ tr/\././);
- if ($thisord < $thatord)
- { $ret = 1; }
- elsif ($thisord > $thatord)
- { $ret = 0; }
- else
- { $ret = &rev_lt($that, $this); }
- }
- return $ret;
- }
- # Maximum size for a log message we'll keep.
- # Messages beyond this get truncated, to accomodate a limitation
- # on the key/value pair size in ndbm. That's life.
- #
- $MAXSZ = 256*3;
- # Generate the metadata for a single file
- #
- sub dofile
- {
- local($dir, $file) = @_;
- if ($file !~ /,v$/) { return; }
- if ($IGNOREFILES && $file =~ /$IGNOREFILES/) { return; }
- if ($file =~ /[\000-\037\177-\377]/)
- {
- print "$Myname: RCS filename with non-printable characters (skipped): ";
- $l = length($file);
- for ($i = 0; $i <= $l; $i++)
- {
- $c = substr($file, $i, 1);
- if ($c =~ /[\000-\037\177-\377]/)
- { printf "\\%03o", ord($c); }
- else
- { print "$c"; }
- }
- print "\n";
- return;
- }
- elsif ($file =~ /\.\.\./)
- {
- print "$Myname: RCS filename with illegal Perforce characters (skipped): $file\n";
- return;
- }
- #if ($file ne "rm.c,v") { return; }
- undef %RCS_lines;
- undef %RCS_Branches;
- undef $Firstusedrev;
- print "$dir/$file";
- # This parses the RCS information from the ,v file, filling
- # in various data structures that we use, below.
- #
- if (&set_RCS_revs("$dir/$file", 0) == undef) { print " (empty)\n"; return; } # empty ,v
- # What RCS keyword expansion options are in effect?
- # (We use this to detect binary files)
- #
- $options = "${RCS_expand}$RCS_exec";
- if (! $options) { $options = "-"; }
- @path = split(/\//, "$dir/$file");
- $file = pop(@path);
- $file =~ s/,v$//;
- if ($path[$#path] eq "Attic") { pop @path; }
- $na_dir = join("/", @path);
- $path = sprintf("%s%s%s", $dir, $dir ? "/" : "", $file);
- $na_path = sprintf("%s%s%s", $na_dir, $na_dir ? "/" : "", $file);
- print " -> $path\n";
- # The "defined($Files_seen{$path})" saves lots of stat()s!
- #
- if (defined($Files_seen{$path}))
- {
- my @p = split(/\//, "$na_path");
- splice(@p, $#p, 0, "Attic");
- my $a_path = join("/", @p);
- # Users have seen this, which previous caused mysterious death
- # in the sort phase... let's be a little more informative:
- #
- if (-f "$na_path,v" && -f "$a_path,v")
- {
- die "assert: CVS repository has both\n $na_path\nand\n $a_path"; }
- else
- { die "assert: dofile(): duplicate path: $na_path"; }
- }
- $Files_seen{$path} = 1;
- # For all of the branches we see, store the tip revision in
- # $HAVELINES{$line}; this is also where we weed out
- # codelines we are not interested in.
- #
- foreach $line ((keys %RCS_Branchtags), $TRUNKLINE)
- {
- $no_flash_line = $line;
- if (defined($BRANCH_FLASH)) { $no_flash_line =~ s/$BRANCH_FLASH$//; }
- if ($WANTLINES && ! (defined($WANTLINES{$no_flash_line}))) { next; }
- if (($tiprev = &rev_on_line($line)) eq "none") { next; }
- $HAVELINES{$line} = $tiprev;
- }
- # Now we go through each line, to build a list of the RCS revs that
- # need to be exported into the metadata stream.
- #
- while (1) # We have more lines to deal with...
- {
- (@k) = (keys %HAVELINES);
- if ($#k < 0) { last; }
- my $theline;
- # Choose the highest numbered line of the lowest "order" for
- # the next one to export... this will always pickup lines on
- # branches nearer the trunk first, so the subsequent branches
- # will have a place to branch from!
- #
- foreach $k (@k)
- {
- if ($k eq $TRUNKLINE) { $theline = $k; last; }
- # if both lines select the *same* revision...
- #
- if ($HAVELINES{$k} eq $HAVELINES{$theline})
- {
- # ...take the one with the lower branch tag order first
- #
- if (&linerev_gt($RCS_Branchtags{$k}, $RCS_Branchtags{$theline}))
- { $theline = $k; next; }
- }
- if (&linerev_gt($HAVELINES{$k}, $HAVELINES{$theline}))
- { $theline = $k; }
- }
- $rev = $tiprev = &rev_on_line($theline);
- $t = $theline;
- if (defined($BRANCH_FLASH))
- { $t =~ s/$BRANCH_FLASH$//; }
- # This is where we build the list of codelines we've encountered.
- #
- $All_lines{$t} = 1;
- if ( (defined($RCS_lines{$rev})) &&
- ($theline ne $TRUNKLINE) &&
- (($rev =~ tr/\././) < ($RCS_Branchtags{$theline} =~ tr/\././)))
- {
- if ($RCS_Branches{$rev}) { $RCS_Branches{$rev} .= ":"; }
- $RCS_Branches{$rev} .= $t;
- }
- else
- {
- while ($rev && ! defined($RCS_lines{$rev}))
- {
- $RCS_lines{$rev} = $theline;
- $rev = $RCS_Prevs{$rev};
- }
- if ($rev)
- {
- if ($RCS_Branches{$rev}) { $RCS_Branches{$rev} .= ":"; }
- $RCS_Branches{$rev} .= $t;
- }
- }
- # We test for "if $rev" here cause it may have gone null if the while loop
- # above ran off the end...
- #
- if ($rev && (($rev =~ tr/\././) == 1) && &rev_lt($rev, $Firstusedrev))
- { $Firstusedrev = $rev }
- delete $HAVELINES{$theline};
- }
- # OK, we have the set of revisions to export - write them to the
- # metadata stream.
- #
- foreach $rev (keys %RCS_Revs)
- {
- $revkey = "$path/$rev";
- $state = $RCS_States{$rev};
- $author = $RCS_Authors{$rev};
- $date = $RCS_Dates{$rev};
- my ($yr, $mo, $da, $hr, $mi, $se) = split (/\./, $date);
- $date = timegm($se,$mi,$hr,$da,$mo - 1,$yr);
- $line = $RCS_lines{$rev};
- if (defined($BRANCH_FLASH)) { $line =~ s/$BRANCH_FLASH$//; }
- $branches = $RCS_Branches{$rev};
- # Detect revisions before the first branch point, and
- # omit them if we're not doing ALLTHEWAYBACK.
- #
- if ( (! $ALLTHEWAYBACK)
- && ($line eq $TRUNKLINE)
- && ($rev ne $RCS_Tags{"head"})
- && $Firstusedrev
- && &rev_lt($rev, $Firstusedrev))
- { next; }
- if (! $line) { next; }
- if (! $branches) { $branches = "-"; }
- if ((! $ALLTHEWAYBACK) && $rev eq $Firstusedrev)
- { $prevrev = "-"; }
- elsif ($RCS_Prevs{$rev})
- { $prevrev = $RCS_Prevs{$rev}; }
- else
- { $prevrev = "-"; }
- $All_lines{$line} = 1;
- if ($RCS_import_is_main)
- {
- if ($line eq "import") { $line = $TRUNKLINE; }
- my @btmp = split(/ /, $branches);
- my $newb = "";
- foreach my $b (@btmp)
- {
- if ($b eq "import") { next; }
- if ($newb) { $newb .= " "; }
- $newb .= $b;
- }
- $branches = $newb;
- }
- print METATMP "$revkey$S$date$S$author$S$state$S$line$S$branches$S$prevrev$S$options\n";
- # MAXSZ derives from a ndbm limitation on the size of a key/entry pair.
- # at (256*3) it allows for a $revkey up to 250 chars or so.
- #
- $logmsg = substr($RCS_Logs{$rev}, 0, $MAXSZ);
- if ($logmsg !~ /\n$/) { $logmsg .= "\n"; }
- if (length($logmsg)+length($revkey) > 1010)
- { print "$Myname: revkey + log too long for <$revkey>\n"; exit 1; }
- $MSGS{$revkey} = $logmsg;
- }
- }
- # option switch variables get defaults here...
- $Convdir = "";
- $Boolopt = 0;
- $Valopt = 0;
- while ($#ARGV >= 0)
- {
- if ($ARGV[0] eq "-boolopt") { $Boolopt = 1; shift; next; }
- elsif ($ARGV[0] eq "-valopt")
- {
- shift; if ($ARGV[0] < 0) { &usage; }
- $Valopt = $ARGV[0]; shift; next;
- }
- elsif ($ARGV[0] eq "-help")
- { &help; }
- elsif ($ARGV[0] =~ /^-/) { &usage; }
- if ($Args ne "") { $Args .= " "; }
- push(@Args, $ARGV[0]);
- shift;
- }
- if ($#Args ne 0) { &usage; }
- $Convdir = $Args[0];
- $Metatmp = "$Convdir/metatmp";
- $Metadata = "$Convdir/metadata";
- $Labels = "$Convdir/labels";
- $LabelsLst = "$Convdir/labels.lst";
- $Logmsgs = "$Convdir/logmsgs";
- $Changes = "$Convdir/changes";
- $Revmap = "$Convdir/revmap";
- $Revtags = "$Convdir/revtags";
- $Clientdir = "$Convdir/p4";
- require "$Convdir/config";
- # (Handle either f or f.db or f.pag, f,dir style dbs):
- #
- if (&s("/bin/rm -rf $Logmsgs $Logmsgs.db $Logmsgs.pag $Logmsgs.dir ".
- "$Changes $Clientdir ".
- "$Revmap $Revmap.db $Revmap.pag $Revmap.dir ".
- "$Revtags $Revtags.db Revtags.pag $Revtags.dir"))
- { die "/bin/rm -rf $Logmsgs ..."; }
- use DB_File;
- $DBMCLASS="DB_File";
- $myhashinfo = new DB_File::HASHINFO;
- $myhashinfo->{bsize} = 65536;
- if (! tie(%MSGS, $DBMCLASS, $Logmsgs, O_CREAT|O_RDWR, 0666, $myhashinfo))
- { print "$Myname: can't tie \"$Logmsgs\": $!\n"; exit 1; }
- if (! tie(%RCS_Revtags, $DBMCLASS, $Revtags, O_CREAT|O_RDWR, 0666, $myhashinfo))
- { print "$Myname: can't tie \"$Revtags\": $!\n"; exit 1; }
- if (! open(METATMP, ">$Metatmp"))
- { print "$Myname: can't open \">$Metatmp\": $!\n"; exit 1; }
- #chdir $CVS_MODULE || die "$Myname: can't chdir \"$CVS_MODULE\": $!";
- #$CVS_MODULE = `/bin/pwd`; chop $CVS_MODULE;
- #chdir $Here || die "$Myname: can't chdir \"$Here\": $!";
- &traverse($CVS_MODULE, 0, "dofile");
- close METATMP;
- sub metasort
- {
- my @a = split(/$S/, $a);
- my @b = split(/$S/, $b);
- # The revision time is the primary sort key
- # - But this is now handled by the external sort; we still
- # do secondary and tertiary sort keys, below
- #
- # if ($a[1] != $b[1]) { return $a[1] <=> $b[1]; }
- $a[0] =~ s/^(.*)\///; my $apath = $1;
- $b[0] =~ s/^(.*)\///; my $bpath = $1;
- # Next is the pathname
- #
- if ($apath ne $bpath) { return $apath cmp $bpath; }
- # If we're still tied, it goes to the revision number!
- #
- @aa = split(/\./, $a[0]);
- @bb = split(/\./, $b[0]);
- for (my $i = 0; $i <= $#aa; $i=$i+2)
- {
- if (! defined($bb[$i])) { return 1; } # a has more positions, thus greater
- if ($aa[$i] < $bb[$i]) { return -1; } # a is less than b, thus less
- if ($aa[$i] > $bb[$i]) { return 1; } # and vice-versa
- # if they are equal, we look to the next position:
- #
- if (! defined($aa[$i+1]))
- { die "impossible sort key (RCS rev) \"$a[0]\"?\n"; }
- if (! defined($bb[$i+1]))
- { die "impossible sort key (RCS rev) \"$b[0]\"?\n"; }
- if ($aa[$i+1] < $bb[$i+1]) { return -1; } # a is less than b, thus less
- if ($aa[$i+1] > $bb[$i+1]) { return 1; } # and vice-versa
- # Otherwise, we go on to the next level...
- }
- if ($#bb > $#aa) { return -1; }
- die "impossible equal sort keys:\n <$a>\n <$b>\n";
- }
- my $cmd = "sort -n -t $S +1 < $Metatmp |";
- if (! open(METASORT, $cmd))
- { print "$Myname: can't open \"$cmd\": $!\n"; exit 1; }
- if (! open(META, ">$Metadata"))
- { print "$Myname: can't open \">$Metadata\": $!\n"; exit 1; }
- # Do the sorting in chunks, per primary sort key. (We're going through
- # all of this, BTW, in order to constrain genmetadata's memory
- # footprint, which was getting huge when we held all of the tags and
- # metadata in-core)
- #
- my $t = 0;
- my @Meta;
- while (<METASORT>)
- {
- chomp;
- my @r = split(/$S/, $_);
- if ($r[1] ne $t)
- {
- if ($#Meta >= 0)
- {
- my @Metasorted = sort metasort @Meta;
- foreach my $m (@Metasorted) { print META "$m\n"; }
- }
- $t = $r[1];
- @Meta = ();
- }
- push (@Meta, $_);
- }
- if ($#Meta >= 0)
- {
- my @Metasorted = sort metasort @Meta;
- foreach my $m (@Metasorted) { print META "$m\n"; }
- }
- close METASORT;
- close META;
- if (! open(LABELS, ">$Labels"))
- { print "$Myname: can't open \">$Labels\": $!\n"; exit 1; }
- if (! open(LABELSLST, ">$LabelsLst"))
- { print "$Myname: can't open \">$LabelsLst\": $!\n"; exit 1; }
- print "===== Labels referenced:\n";
- print LABELSLST "===== Labels referenced:\n";
- foreach $label (sort(keys(%RCS_Revtags)))
- {
- $sublabel = $label;
- if ($label =~ m/[\#\@]/)
- {
- $sublabel =~ s/\#/_hash_/g;
- $sublabel =~ s/\@/_atsym_/g;
- }
- print "$sublabel\n";
- print LABELS "$sublabel\n";
- print LABELSLST "$sublabel\n";
- foreach $rev (@{$RCS_Revtags{$label}})
- { print LABELS " $rev\n"; }
- }
- close LABELS;
- close LABELSLST;
- untie %MSGS;
- untie %RCS_Revtags;
- &s("rm -rf $Revtags $Revtags.db $Revtags.pag $Revtags.dir");
- $Lines = "$Convdir/lines";
- if (! open(LINES, ">$Lines"))
- { print "$Myname: can't open \">$Lines\": $!\n"; }
- else
- {
- print "===== Lines referenced:\n";
- print LINES "===== Lines referenced:\n";
- foreach $line (sort keys %All_lines)
- {
- print "$line\n";
- print LINES "$line\n";
- }
- close LINES;
- }
- exit 0;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#5 | 5210 | Naveen Patil | MERGE - Merged from CVS2P4 2.5.5 * includes purely merged files that resol...ved automatically with [-am] « |
19 years ago | |
#4 | 5134 | Naveen Patil | Added ability to specify CVS symbolic tags that need to be imported as Perforce labels &n...bsp; * convdir/config can define WANTTAGS and list of CVS symbolic tags * bin/genmetadata generates list of CVS symbolic tags in convdir/labels.lst, which can be used to configure the WANTTAGS list in convdir/config * if WANTTAGS is defined, bin/dolabels only imports the CVS symbolic tags listed in convdir/config « |
19 years ago | |
#3 | 5130 | Naveen Patil | Fix from Rich Geiger to correctly handle "mergepoint1" token in CVS/RCS file, &nbs...p; which caused versions on the trunk to get incorrectly created on branches. « |
19 years ago | |
#2 | 5129 | Naveen Patil | Increase bsize of HASHINFO structure from 4096 to 65536 to fix "file size exceeded" error ... from bin/dochanges, as suggested by Marc Tooley (Perforce Support); not really sure what this does, but worked! « |
19 years ago | |
#1 | 5127 | Naveen Patil | BRANCH - Branched //public/perforce/utils/cvs2p4/... | 19 years ago | |
//guest/perforce_software/utils/cvs2p4/bin/genmetadata | |||||
#27 | 4923 | Richard Geiger | Integrate 2.5.1-3 changes. | 20 years ago | |
#26 | 4735 | Richard Geiger | This is release 2.5, which handles those four extra special characters Perforce 2004.2 ki...nd-of allows :-) « |
20 years ago | |
#25 | 4354 | Richard Geiger | Integrate 2.4 changes. | 21 years ago | |
#24 | 4274 | Richard Geiger | Publish 2.3.8 | 21 years ago | |
#23 | 3711 | Richard Geiger | release 2.3.7 | 21 years ago | |
#22 | 2449 | rmg | Public 2.3.4 | 22 years ago | |
#21 | 2285 | rmg | Publish 2.3.3 | 22 years ago | |
#20 | 2063 | rmg | Publish 2.3.2 | 23 years ago | |
#19 | 1989 | Richard Geiger | Public 2.3.1 | 23 years ago | |
#18 | 1946 | rmg | Publish 2.1 | 23 years ago | |
#17 | 1786 | rmg | Publish 2.0 | 23 years ago | |
#16 | 1439 | rmg | Publish 1.3.3 | 23 years ago | |
#15 | 1410 | rmg | Publish 1.3.2 | 23 years ago | |
#14 | 1205 | Richard Geiger | Publish 1.3.1 | 23 years ago | |
#13 | 1187 | Richard Geiger |
1.3. Mainly, support for labels! |
23 years ago | |
#12 | 1033 | Richard Geiger | publish 1.2.17 | 23 years ago | |
#11 | 476 | Richard Geiger | publish cvs2p4 1.2.15 | 24 years ago | |
#10 | 462 | Richard Geiger | publish 1.2.14 to the public site. | 24 years ago | |
#9 | 418 | Richard Geiger | Publish 1.2.12 | 25 years ago | |
#8 | 400 | Richard Geiger | Publish 1.2.11 | 25 years ago | |
#7 | 395 | Richard Geiger | 1.2.10 | 25 years ago | |
#6 | 344 | Richard Geiger | 1.2.9 | 25 years ago | |
#5 | 333 | Richard Geiger | Publish 1.2.8 (Not usre why test/file,v was included in this integration; am guessing it... was a missed integrations left over from 1.2.7, perhaps) « |
25 years ago | |
#4 | 256 | james | push cvs2p4 1.2.6 to public area | 25 years ago | |
#3 | 242 | james | Pull cvs2p4 into //public so latest version (1.2.5) gets synced onto the Perforce FTP are...a. Note the cvs2p4-latest.tar symlink - I'll update loadsupp to point to that. « |
25 years ago | |
#2 | 230 | Laura Wingerd | Pull cvs2p4 into //public so latest version (1.2.4) gets synced onto the Perforce FTP are...a. « |
26 years ago | |
#1 | 152 | Laura Wingerd | cvs2p4 goes public. | 26 years ago | |
//guest/richard_geiger/utils/cvs2p4/bin/genmetadata | |||||
#1 | 130 | Richard Geiger | CVS-to-Perforce converter. This is release 1.2.2 (first submit to the Perforce Public Dep...ot) « |
26 years ago |