- 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/richard_geiger/utils/cvs2p4/bin/genmetadata#14 $
- #
- # Richard Geiger
- #
- require 5.000;
- #use bytes;
- 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;
- }
- sub mklabel
- {
- my ($label, @Revs) = @_;
- print "make label: $label\n";
- $label = &atq($label);
- my $time = time;
- print DBLBLS "\@pv\@ 2 \@db.domain\@ $label 108 \@\@ \@\@ ".
- "\@cvs2p4\@ $time $time 8 0 \@Created by cvs2p4.\@\n";
- }
- # 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; }
- push(@Args, $ARGV[0]);
- shift;
- }
- if ($#Args ne 0) { &usage; }
- $Convdir = $Args[0];
- #chdir $Convdir || die "$Myname: can't chdir \"$Convdir\": $!";
- #$Convdir = `/bin/pwd`; chop $Convdir;
- #chdir $Here || die "$Myname: can't chdir \"$Here\": $!";
- require "$Convdir/config";
- # Load %Tags...
- my %Tags;
- if (-e "$Convdir/tags.txt")
- {
- if (! open(LBLMAP, "<$Convdir/tags.txt"))
- { die "Could not open \"$Convdir/tags.txt\": $!\n"; }
- while (<LBLMAP>)
- {
- chomp;
- my (@t) = split(/\s+/, $_);
- $Tags{$t[0]} = $t[1];
- }
- close LBLMAP;
- my @nmap = keys(%Tags);
- my $n = $#nmap + 1;
- print "$Myname: loaded label map; $n labels.\n";
- }
- $Metadata = "$Convdir/metadata";
- $Labels = "$Convdir/labels";
- $Rrevmap = "$Convdir/rrevmap";
- #$DBlbls = "$P4ROOT/dblbls";
- $Checkpoint = "checkpoint";
- # Path the the p4 client command
- #
- if (! defined($P4)) { $P4 = "/usr/local/bin/p4"; }
- if (! -x ($P4))
- { print "$Myname: No executable \"p4\" command at \"$P4\".\n"; exit 1; }
- $P4 = "$P4 -p $P4PORT -c cvs2p4 -u $P4USER";
- use DB_File;
- $DBMCLASS="DB_File";
- #$myhashinfo = new DB_File::HASHINFO;
- #$myhashinfo->{bsize} = 4096;
- $myhashinfo = new DB_File::BTREEINFO;
- $myhashinfo->{cachesize} = (1024 * 1024) * 256;
- if (! tie(%RREVMAP, $DBMCLASS, $Rrevmap, O_RDONLY, 0444, $myhashinfo))
- { print "$Myname: can't tie \"$Rrevmap\": $!\n"; exit 1; }
- if (! open(LABELS, "<$Labels"))
- { print "$Myname: can't open \">$Labels\": $!\n"; exit 1; }
- # Open the db metadata (journal format) file we will write
- #
- #$DBlbls =~ s%^.*/%%;
- $P4D = "$P4D -r .";
- if (! open(DBLBLS, "| (cd $P4ROOT && $P4D -jr -)"))
- { print "$Myname: can't open \"| (cd $P4ROOT && $P4D -jr -)\": $!\n"; exit 1; }
- #if (&s("cd $P4ROOT && $P4D -jr $DBlbls"))
- # { print "$Myname: \"$P4D -jr $DBlbls\" failed.\n"; exit 1; }
- #if (! open(DBLBLS, ">$DBlbls"))
- # { print "$Myname: can't open \"$DBlbls\": $!\n"; exit 1; }
- ################################################################################
- #
- # branch_for_tag()
- #
- # Please see "IMPORTING CVS TAGS AS PERFORCE LABELS" in the README
- # file for background.
- #
- # If you need to supply a custom mapping function, you can
- # add your code where indicated below.
- #
- # branch_for_tag() takes an RCS revision tag, and returns a list, being the name(s)
- # of the branch(s) that the revision is associated with: (It can be > 1 when it's
- # a 1.1.1.N revision that "was present in main" by virtue of no 1.2 having been
- # committed yet.
- #
- my %bft; # We cache the answers here for performance.
- sub branch_for_tag
- {
- my ($tag) = @_;
- if ($bft{$tag}) { return @{$bft{$tag}}; }
- my @Tags = split(/$S/, $Tags{$tag});
- if ($#Tags < 0) { return (); }
- if ($#Tags == 0)
- {
- if ($Tags[0] eq "UNMAPPED")
- { $bft{$tag} = (); }
- else
- { $bft{$tag} = ($Tags[0]); }
- return @{$bft{$tag}};
- }
- my @ret;
- foreach my $t (@Tags)
- { if ($t ne "UNMAPPED") { push(@ret, $t); } }
- $bft{$tag} = \@ret;
- return @{$bft{$tag}};
- }
- # This function takes a p4path on other than "main", and returns the
- # equivalent path on "main". Note that the branch-level directory
- # might be in a different position for different depot paths, but
- # we don't currently handle that case...
- #
- sub spoof_path
- {
- # ($d is for passing in a debug flag):
- #
- my ($p4path, $module, $import, $mainname, $d) = @_;
- if (defined($Depotmap{$module}))
- {
- # We have a Depotmap entry - use it!
- #
- my ($path) = ($p4path =~ m/^\/\/[^\/]+\/[^\/]+\/(.*)$/);
- $p4path = "$Depotmap{$module}/$mainname/$module/$path";
- }
- else
- {
- # Not using Depotmap for this one...
- #
- $p4path =~ s%^//[^/]+/$import/(.*)$%$P4_DEPOT/$mainname/$1%;
- }
- return $p4path;
- }
- ## The second function you may need to pay attention to is rev_on_branch().
- ##
- ## Usually, this will be just as shown here, where it involves
- ## comparing a component of the revision's pathname (i.e., the
- ## "branch-level directory" in Perforce, with the given $tag_branch.
- ## The result of the comparison is the result of the function.
- ##
- ## If your conversion uses the default arrangement in the cvs2p4
- ## config file, so that the third pathname component is the branch
- ## name, e.g.,
- ##
- ## //depot/<module>/<branch>/...
- ##
- ## you won't need to change this at all. Note, however, that you will
- ## need to adjust this if you've decided to use other than just the single
- ## "//depot"
- ##
- #
- #sub rev_on_branch
- #{
- # my ($rev, $tag_branch) = @_;
- # my ($branch) = ($rev =~ /^\/\/[^\/]+\/([^\/]+)\//);
- # return ($branch eq $tag_branch);
- #}
- #
- # End of branch_for_tag() stuff...
- #
- ################################################################################
- my %Labels_seen;
- my $nline = 0;
- while (<LABELS>)
- {
- $nline++;
- if (($nline % 1000) == 0) { print "nline <$nline>\n"; }
- chomp $_;
- my ($label, $path, $rev, $import_as_main) = split(/$S/, $_);
- # Make sure we have the reverse mapping for the RCS revision.
- # (I.e., the set of Perforce revisions in different branches that
- # share the RCS revision)
- #
- if (! ($revs = $RREVMAP{"$path/$rev"}))
- {
- # This can happen when there are tags on nonexistent revisions,
- # like the "x" tag in the test data set.
- #
- print "WARNING: no reverse rev map entry for RCS revision <$path/$rev> for label <$label>\n";
- next;
- }
- if ($DISCARD_UNMAPPED_TAGS && ! defined($Tags{$label}))
- { print "DROPPING UNMAPPED TAG [$_]\n"; next; }
- # Use $path to determine the cvs "module" this is from...
- #
- my ($module) = ($path =~ m/$CVS_ROOT\/([^\/]+)\//);
- my @tag_branches;
- if ($import_as_main)
- { @tag_branches = ("main", $import_as_main); }
- else
- { @tag_branches = &branch_for_tag($label); }
- foreach my $tag_branch (@tag_branches)
- {
- my $spoofp4rev;
- my @emissions;
- foreach my $tryp4rev (split(/\001/, $revs))
- {
- my ($p4path, $p4rev) = ($tryp4rev =~ m/^(.*)#(.*)$/);
- my $p4_branch = $p4path;
- # Arbitrary depotmap TBD!
- #
- ($p4_branch) = ($p4_branch =~ m/^\/\/[^\/]+\/([^\/]+)/);
- if ($tag_branch eq "$MAINNAME" && $p4_branch eq $import_as_main && $p4rev eq "1")
- {
- my $spoofpath = &spoof_path($p4path, $module, $import_as_main, $MAINNAME, $d);
- $spoofp4rev = "$spoofpath$S$p4rev";
- }
- if ($DISCARD_UNMAPPED_TAGS)
- { $emit = $tag_branch && ($tag_branch eq $p4_branch); }
- else
- { $emit = 1; }
- if ($emit) { push(@emissions, "$p4path$S$p4rev"); }
- }
- # We need the spoof when we're looking for a main revision to tag
- #
- if ($#emissions < 0 && $spoofp4rev)
- { push(@emissions, $spoofp4rev); }
- foreach my $emit (@emissions)
- {
- my ($p4path, $p4rev) = split(/$S/, $emit);
- if (! defined($Labels_seen{$label}))
- {
- &mklabel($label);
- $Labels_seen{$label} = 1;
- }
- $p4path = &p4_esc($p4path);
- $p4path = &atq($p4path);
- print DBLBLS "\@pv\@ 0 \@db.label\@ \@$label\@ $p4path $p4rev\n";
- }
- if ($p4path eq $path) { last; }
- $p4rev = "";
- }
- }
- close DBLBLS;
- close LABELS;
- untie %RREVMAP;
- exit 0;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 5974 | Ashish Melanta | Pulling in the Perforce utils into my guest branch | 18 years ago | |
//guest/perforce_software/utils/cvs2p4/bin/dolabels | |||||
#12 | 5649 | Richard Geiger | Integrate 3.0b5, b6 changes... | 19 years ago | |
#11 | 5619 | Richard Geiger | Changes for 3.0b4 | 19 years ago | |
#10 | 5601 | Richard Geiger | Integrate 3.0 changes, preparing to publish. | 19 years ago | |
#9 | 5145 | Richard Geiger | Publish 2.5.5 | 20 years ago | |
#8 | 4354 | Richard Geiger | Integrate 2.4 changes. | 21 years ago | |
#7 | 3711 | Richard Geiger | release 2.3.7 | 22 years ago | |
#6 | 2063 | rmg | Publish 2.3.2 | 23 years ago | |
#5 | 1989 | Richard Geiger | Public 2.3.1 | 23 years ago | |
#4 | 1786 | rmg | Publish 2.0 | 23 years ago | |
#3 | 1410 | rmg | Publish 1.3.2 | 23 years ago | |
#2 | 1205 | Richard Geiger | Publish 1.3.1 | 23 years ago | |
#1 | 1187 | Richard Geiger |
1.3. Mainly, support for labels! |
23 years ago | |
//guest/richard_geiger/utils/cvs2p4/bin/dolabels | |||||
#1 | 1185 | Richard Geiger |
Changes for 1.3 (Labels!) |
23 years ago |