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; 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"; foreach my $rev (@Revs) { my ($f, $r) = split(/#/, $rev); $f = &atq($f); print DBLBLS "\@pv\@ 0 \@db.label\@ $label $f $r\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"; $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; 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 # if (! open(DBLBLS, ">$DBlbls")) { print "$Myname: can't open \"$DBlbls\": $!\n"; exit 1; } @Revs = (); while (<LABELS>) { if (/^([^\s]+)/) { if ($#Revs >= 0) { &mklabel($label, @Revs); } $label = $1; @Revs = (); } elsif (/^ (.*)/) { if ($revs = $RREVMAP{$1}) { foreach $rev (split(/\001/, $revs)) { push (@Revs, $rev); } } } } if ($#Revs >= 0) { &mklabel($label, @Revs); } close DBLBLS; close LABELS; untie %RREVMAP; $DBlbls =~ s%^.*/%%; $P4D = "$P4D -r ."; if (&s("cd $P4ROOT && $P4D -jr $DBlbls")) { print "$Myname: \"$P4D -jr $DBlbls\" failed.\n"; exit 1; } if (&s("cd $P4ROOT && rm -f $Checkpoint; $P4D -jd $Checkpoint")) { print "$Myname: \"$P4D -jd $Checkpoint\" failed.\n"; exit 1; } exit 0;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 2778 | Jay Han | creating guest branch per tutorial http://public.perforce.com/public/tutorial.html | ||
//guest/perforce_software/utils/cvs2p4/bin/dolabels | |||||
#6 | 2063 | rmg | Publish 2.3.2 | ||
#5 | 1989 | Richard Geiger | Public 2.3.1 | ||
#4 | 1786 | rmg | Publish 2.0 | ||
#3 | 1410 | rmg | Publish 1.3.2 | ||
#2 | 1205 | Richard Geiger | Publish 1.3.1 | ||
#1 | 1187 | Richard Geiger |
1.3. Mainly, support for labels! |
||
//guest/richard_geiger/utils/cvs2p4/bin/dolabels | |||||
#1 | 1185 | Richard Geiger |
Changes for 1.3 (Labels!) |