package VCP::Source::cvs ; =head1 NAME VCP::Source::cvs - A CVS repository source =head1 SYNOPSIS vcp cvs:module/... -d ">=2000-11-18 5:26:30" # All file revs newer than a date/time vcp cvs:module/... -r foo # all files in module and below labelled foo vcp cvs:module/... -r foo: # All revs of files labelled foo and newer, # including files not tagged with foo. vcp cvs:module/... -r 1.1:1.10 # revs 1.1..1.10 vcp cvs:module/... -r 1.1: # revs 1.1 and up on main trunk ## NOTE: Unlike cvs, vcp requires spaces after option letters. =head1 DESCRIPTION Source driver enabling L|vcp> to extract versions form a cvs repository. The source specification for CVS looks like: cvs:cvsroot/filespec [] where the C is passed to C with the C<-d> option if provided (C is optional if the environment variable C is set) and the filespec and EoptionsE determine what revisions to extract. C may contain trailing wildcards, like C to extract an entire directory tree. If the CVSROOT / -d option looks like a local filesystem (if it doesn't start with ":" and if it points to an existing directory or file), this module will read the RCS files directly from the hard drive unless --use-cvs is passed. This is more accurate (due to poor design of the cvs log command) and much, much faster. =head1 OPTIONS =over =item -b, --bootstrap -b ... --bootstrap=... -b file1[,file2[, etc.]] --bootstrap=file1[,file2[, etc. ]] (the C<...> there is three periods, a L wildcard borrowed from C path syntax). Forces bootstrap mode for an entire export (C<-b ...>) or for certain files. Filenames may contain wildcards, see L for details on what wildcards are accepted. Controls how the first revision of a file is exported. A bootstrap export contains the entire contents of the first revision in the revision range. This should only be necessary when exporting for the first time. An incremental export contains a digest of the revision preceding the first revision in the revision range, followed by a delta record between that revision and the first revision in the range. This allows the destination import function to make sure that the incremental export begins where the last export left off. The default is decided on a per-file basis: if the first revision in the range is revision #.1, the full contents are exported. Otherwise an incremental export is done for that file. This option is necessary when exporting only more recent revisions from a repository. =item --cd Used to set the CVS working directory. VCP::Source::cvs will cd to this directory before calling cvs, and won't initialize a CVS workspace of it's own (normally, VCP::Source::cvs does a "cvs checkout" in a temporary directory). This is an advanced option that allows you to use a CVS workspace you establish instead of letting vcp create one in a temporary directory somewhere. This is useful if you want to read from a CVS branch or if you want to delete some files or subdirectories in the workspace. If this option is a relative directory, then it is treated as relative to the current directory. =item -kb, -k b Pass the -kb option to cvs, forces a binary checkout. This is useful when you want a text file to be checked out with Unix linends, or if you know that some files in the repository are not flagged as binary files and should be. =item --rev-root B. Falsifies the root of the source tree being extracted; files will appear to have been extracted from some place else in the hierarchy. This can be useful when exporting RevML, the RevML file can be made to insert the files in to a different place in the eventual destination repository than they existed in the source repository. The default C is the file spec up to the first path segment (directory name) containing a wildcard, so cvs:/a/b/c... would have a rev-root of C. In direct repository-to-repository transfers, this option should not be necessary, the destination filespec overrides it. =item -r -r v_0_001:v_0_002 -r v_0_002: Passed to C as a C<-r> revision specification. This corresponds to the C<-r> option for the rlog command, not either of the C<-r> options for the cvs command. Yes, it's confusing, but 'cvs log' calls 'rlog' and passes the options through. IMPORTANT: When using tags to specify CVS file revisions, it would ordinarily be the case that a number of unwanted revisions would be selected. This is because the behavior of the cvs log command dumps the entire log history for any files that do not contain the tag. VCP captures the histories of such files and ignores all revisions that are older or newer than any files that match the tags. Be cautious using HEAD as the end of a revision range, this seems to cause the delete actions for files deleted in the last revision to not be noticed. Not sure why. =item --use-cvs Do not try to read local repositories directly; use the cvs command line interface. This is much slower than reading the files directly but is useful to see if there is a bug in the RCS file parser or possible when dealing with corrupt RCS files that cvs will read. If you find that this option makes something work, please let me know (barrie@slaysys.com). Thanks. =item C<-d> -d "2000-11-18 5:26:30<=" Passed to 'cvs log' as a C<-d> date specification. WARNING: if this string doesn't contain a '>' or '<', you're probably doing something wrong, since you're not specifying a range. vcp may warn about this in the future. =back =head2 Files that aren't tagged CVS has one peculiarity that this driver works around. If a file does not contain the tag(s) used to select the source files, C outputs the entire life history of that file. We don't want to capture the entire history of such files, so L goes ignores any revisions before and after the oldest and newest tagged file in the range. =head1 LIMITATIONS "What we have here is a failure to communicate!" - The warden in Cool Hand Luke CVS does not try to protect itself from people checking in things that look like snippets of CVS log file: they come out exactly like they went in, confusing the log file parser. So, if a repository contains messages in the log file that look like the output from some other "cvs log" command, things will likely go awry. CVS stores the -k keyword expansion setting per file, not per revision, so vcp will mark all revisions of a file with the current setting of the -k flag for a file. At least one cvs repository out there has multiple revisions of a single file with the same rev number. The second and later revisions with the same rev number are ignored with a warning like "Can't add same revision twice:...". =cut $VERSION = 1.2 ; # Removed docs for -f, since I now think it's overcomplicating things... #Without a -f This will normally only replicate files which are tagged. This #means that files that have been added since, or which are missing the tag for #some reason, are ignored. # #Use the L option to force files that don't contain the tag to be #=item -f # #This option causes vcp to attempt to export files that don't contain a #particular tag but which occur in the date range spanned by the revisions #specified with -r. The typical use is to get all files from a certain #tag to now. # #It does this by exporting all revisions of files between the oldest and #newest files that the -r specified. Without C<-f>, these would #be ignored. # #It is an error to specify C<-f> without C<-r>. # #exported. use strict ; use Carp ; use Getopt::Long ; use Regexp::Shellish qw( :all ) ; use VCP::Branches; use VCP::Branch; use VCP::Debug ':debug' ; use VCP::Rev ; use VCP::Source ; use VCP::Utils::cvs ; use base qw( VCP::Source VCP::Utils::cvs ) ; use fields ( 'CVS_CUR', ## The current change number being processed 'CVS_BOOTSTRAP', ## Forces bootstrap mode 'CVS_IS_INCREMENTAL', ## Hash of filenames, 0->bootstrap, 1->incremental 'CVS_INFO', ## Results of the 'cvs --version' command and CVSROOT 'CVS_LABEL_CACHE', ## ->{$name}->{$rev} is a list of labels for that rev 'CVS_LABELS', ## Array of labels from 'p4 labels' 'CVS_MAX', ## The last change number needed 'CVS_MIN', ## The first change number needed 'CVS_REV_SPEC', ## The revision spec to pass to `cvs log` 'CVS_DATE_SPEC', ## The date spec to pass to `cvs log` 'CVS_FORCE_MISSING', ## Set if -r was specified. 'CVS_K_OPTION', ## Which of the CVS/RCS "-k" options to use, if any 'CVS_DIRECT', ## Read CVS files directly instead of through the ## cvs command. Used if the CVSROOT looks local. 'CVS_LOG_CARRYOVER', ## The unparsed bit of the log file 'CVS_LOG_FILE_DATA', ## Data about all revs of a file from the log file 'CVS_LOG_STATE', ## Parser state machine state 'CVS_LOG_REV', ## The revision being parsed (a hash) 'CVS_NAME_REP_NAME', ## A mapping of repository names to names, used to ## figure out what files to ignore when a cvs log ## goes ahead and logs a file which doesn't match ## the revisions we asked for. 'CVS_NEEDS_BASE_REV', ## What base revisions are needed. Base revs are ## needed for incremental (ie non-bootstrap) updates, ## which is decided on a per-file basis by looking ## at VCP::Source::is_bootstrap_mode( $file ) and ## the file's rev number (ie does it end in .1). 'CVS_SAW_EQUALS', ## Set when we see the ==== lines in log file [1] ) ; ## Some aids to testing my $use_cache; my $build_cache; my $time_sort; sub new { my $class = shift ; $class = ref $class || $class ; my VCP::Source::cvs $self = $class->SUPER::new( @_ ) ; ## Parse the options my ( $spec, $options ) = @_ ; $self->parse_cvs_repo_spec( $spec ) ; my $work_dir ; my $rev_root ; my $rev_spec ; my $date_spec ; my $use_cvs ; # my $force_missing ; GetOptions( "b|bootstrap:s" => sub { my ( $name, $val ) = @_ ; $self->{CVS_BOOTSTRAP} = $val eq "" ? [ compile_shellish( "..." ) ] : [ map compile_shellish( $_ ), split /,+/, $val ] ; }, "cd=s" => \$work_dir, "rev-root=s" => \$rev_root, "r=s" => \$rev_spec, "d=s" => \$date_spec, "use-cvs" => \$use_cvs, "k=s" => sub { warn $self->{CVS_K_OPTION} = $_[1] } , "kb" => sub { warn $self->{CVS_K_OPTION} = "b" } , "use-cache" => \$use_cache, "build-cache" => \$build_cache, "time-sort" => \$time_sort, # "f+" => \$force_missing, ) or $self->usage_and_exit ; $self->{CVS_DIRECT} = ! $use_cvs && do { # If the CVSROOT does not start with a colon, it must be # a direct read. But check to see if it exists anyway, # because we'd prefer CVS give the error messages around here. my $root = $self->cvsroot; substr( $root, 0, 1 ) ne ":" && -d $root; }; # unless ( defined $rev_spec || defined $date_spec ) { # print STDERR "Revision (-r) or date (-d) specification missing\n" ; # $self->usage_and_exit ; # } # if ( $force_missing && ! defined $rev_spec ) { # print STDERR # "Force missing (-f) may not be used without a revision spec (-r)\n" ; # $self->usage_and_exit ; # } # my $files = $self->repo_filespec ; unless ( defined $rev_root ) { $self->deduce_rev_root( $files ) ; } ## Don't normalize the filespec. $self->repo_filespec( $files ) ; $self->rev_spec( $rev_spec ) ; $self->date_spec( $date_spec ) ; $self->force_missing( defined $rev_spec ) ; # $self->force_missing( $force_missing ) ; ## Make sure the cvs command is available $self->command_stderr_filter( qr{^ (?:cvs\s (?: (?:server|add|remove):\suse\s'cvs\scommit'\sto.* |tag.*(?:waiting for.*lock|obtained_lock).* ) )\n }x ) ; ## Doing a CVS command or two here also forces cvs to be found in new(), ## or an exception will be thrown. if ( $self->{CVS_DIRECT} ) { my $root = $self->cvsroot; $self->{CVS_INFO} = <cvs( ['--version' ], \$self->{CVS_INFO} ) ; ## This does a checkout, so we'll blow up quickly if there's a problem. unless ( defined $work_dir ) { $self->create_cvs_workspace ; } else { $self->work_root( File::Spec->rel2abs( $work_dir ) ) ; $self->command_chdir( $self->work_path ) ; } } return $self ; } sub cvsroot { my $self = shift; my $root = $self->repo_server; defined $root && length $root ? $root : $ENV{CVSROOT}; } sub is_incremental { my VCP::Source::cvs $self= shift ; my ( $file, $first_rev ) = @_ ; my $bootstrap_mode = substr( $first_rev, -2 ) eq ".1" || ( $self->{CVS_BOOTSTRAP} && grep $file =~ $_, @{$self->{CVS_BOOTSTRAP}} ) ; return $bootstrap_mode ? 0 : "incremental" ; } sub rev_spec { my VCP::Source::cvs $self = shift ; $self->{CVS_REV_SPEC} = shift if @_ ; return $self->{CVS_REV_SPEC} ; } sub rev_spec_cvs_option { my VCP::Source::cvs $self = shift ; return defined $self->rev_spec? "-r" . $self->rev_spec : (), } sub date_spec { my VCP::Source::cvs $self = shift ; $self->{CVS_DATE_SPEC} = shift if @_ ; return $self->{CVS_DATE_SPEC} ; } sub date_spec_cvs_option { my VCP::Source::cvs $self = shift ; return defined $self->date_spec ? "-d" . $self->date_spec : (), } sub force_missing { my VCP::Source::cvs $self = shift ; $self->{CVS_FORCE_MISSING} = shift if @_ ; return $self->{CVS_FORCE_MISSING} ; } sub denormalize_name { my VCP::Source::cvs $self = shift ; ( my $n = '/' . $self->SUPER::denormalize_name( @_ ) ) =~ s{/+}{/}g; return $n; } sub handle_header { my VCP::Source::cvs $self = shift ; my ( $header ) = @_ ; $header->{rep_type} = 'cvs' ; $header->{rep_desc} = $self->{CVS_INFO} ; $header->{rev_root} = $self->rev_root ; $header->{branches} = $self->branches; $self->dest->handle_header( $header ) ; return ; } sub get_rev { my VCP::Source::cvs $self = shift ; my VCP::Rev $r ; ( $r ) = @_ ; my $wp = $self->work_path( "revs", $r->name, $r->rev_id ) ; $r->work_path( $wp ) ; $self->mkpdir( $wp ) ; $self->cvs( [ "checkout", "-r" . $r->rev_id, "-p", $r->source_name, ], '>', $wp, ) ; } sub get_revs_from_log_file { my $self = shift; $self->{CVS_LOG_STATE} = '' ; $self->{CVS_LOG_CARRYOVER} = '' ; $self->revs( VCP::Revs->new ) ; ## We need to watch STDERR for messages like ## cvs log: warning: no revision `ch_3' in `/home/barries/src/revengine/tmp/cvsroot/foo/add/f4,v' ## Files that cause this warning need to have some revisions ignored because ## cvs log will emit the entire log for these files in addition to ## the warning, including revisions checked in before the first tag and ## after the last tag. my $tmp_f = $self->command_stderr_filter ; my %ignore_files ; my $ignore_file = sub { exists $ignore_files{$self->{CVS_NAME_REP_NAME}->{$_[0]}} ; } ; ## This regexp needs to gobble newlines. $self->command_stderr_filter( sub { my ( $err_text_ref ) = @_ ; $$err_text_ref =~ s@ ^cvs(?:\.exe)?\slog:\swarning:\sno\srevision\s.*?\sin\s[`"'](.*)[`"']\r?\n\r? @ $ignore_files{$1} = undef ; '' ; @gxmei ; } ) ; ## ` $self->{CVS_LOG_FILE_DATA} = {} ; $self->{CVS_LOG_REV} = {} ; $self->{CVS_SAW_EQUALS} = 0 ; # The log command must be run in the directory above the work root, # since we pass in the name of the workroot dir as the first dir in # the filespec. my $tmp_command_chdir = $self->command_chdir ; $self->command_chdir( $self->tmp_dir( "co" ) ) ; my $spec = $self->repo_filespec; $spec =~ s{/...\z}{}; ## hack, since cvs always recurses. $self->cvs( [ "log", $self->rev_spec_cvs_option, $self->date_spec_cvs_option, length $spec ? $spec : (), ], '>', sub { $self->parse_log_file( @_ ) }, ) ; #open L, "tmp/gnome/ChangeLog.log" or die $!; #$self->parse_log_file( join "", ); #close L; $self->command_chdir( $tmp_command_chdir ) ; $self->command_stderr_filter( $tmp_f ) ; my $revs = $self->revs ; ## Figure out the time stamp range for force_missing calcs. my ( $min_rev_spec_time, $max_rev_spec_time ) ; if ( $self->force_missing ) { ## If the rev_spec is /:$/ || /^:/, we tweak the range ends. my $max_time = 0 ; $max_rev_spec_time = 0 ; $min_rev_spec_time = 0 if substr( $self->rev_spec, 0, 1 ) eq ':' ; for my $r ( @{$revs->as_array_ref} ) { next if $r->is_base_rev ; my $t = $r->time ; $max_time = $t if $t >= $max_rev_spec_time ; next if $ignore_file->( $r->source_name ) ; $min_rev_spec_time = $t if $t <= ( $min_rev_spec_time || $t ) ; $max_rev_spec_time = $t if $t >= $max_rev_spec_time ; } # $max_rev_spec_time = $max_time if substr( $self->rev_spec, -1 ) eq ':' ; $max_rev_spec_time = undef if substr( $self->rev_spec, -1 ) eq ':' ; debug( "vcp: including files in ['", localtime( $min_rev_spec_time ), "'..'", defined $max_rev_spec_time ? localtime( $max_rev_spec_time ) : "", "']" ) if debugging $self ; } ## Remove extra revs from queue by copying from $revs to $self->revs(). ## TODO: Debug simultaneous use of -r and -d, since we probably are ## blowing away revs that -d included that -r didn't. I haven't ## checked to see if we do or don't blow said revs away. my %oldest_revs ; $self->revs( VCP::Revs->new ) ; for my $r ( @{$revs->as_array_ref} ) { if ( $ignore_file->( $r->source_name ) ) { if ( (!defined $min_rev_spec_time || $r->time >= $min_rev_spec_time) && (!defined $max_rev_spec_time || $r->time <= $max_rev_spec_time) ) { debug( "vcp: including file ", $r->as_string ) if debugging $self ; } else { debug( "vcp: ignoring file ", $r->as_string, ": no revisions match -r" ) if debugging $self ; ## TODO: do a reverse index. for my $nr ( @{$revs->as_array_ref} ) { if ( ( $nr->previous_id || "" ) eq $r->id ) { $nr->previous_id( undef ); $nr->previous( undef ); } } next ; } } ## Because of the order of the log file, the last rev set is always ## the first rev in the range. $oldest_revs{$r->source_name} = $r ; $self->revs->add( $r ) ; } $revs = $self->revs ; ## Add in base revs for my $fn ( keys %oldest_revs ) { my $r = $oldest_revs{$fn} ; my $rev_id = $r->rev_id ; ## TODO: test for when the base revision is on a different branch? if ( $self->is_incremental( $fn, $rev_id ) ) { $rev_id =~ s{(\d+)$}{$1-1}e ; my $br = VCP::Rev->new( id => $self->denormalize_name( $r->name ) . "#$rev_id", source_name => $r->source_name, name => $r->name, branch_id => $r->branch_id, rev_id => $rev_id, type => $r->type, ); my $ok = eval { my $nr = $self->revs->get_last_added( $br ) ; $nr->previous_id( $br->id ) ; $nr->previous( $br ) ; 1 ; } ; die $@ unless $ok || 0 < index $@, "t find revision"; $revs->add( $br ); } } print "\nvcp: found ", 0+$self->revs->get, " revs\n"; } sub get_matching_files_direct { my $self = shift; require File::Find; require Cwd; my $root = $self->cvsroot; my $spec = $self->repo_filespec; my $cwd = Cwd::cwd; chdir $root or die "$!: $root\n"; $spec .= "/..." if $spec !~ m{\/...\z} && -d $spec; $spec =~ s{^/+}{}; local $| = 1; my $hash_count = 0; my $hash_time = 0; my @files; $File::Find::prune = 0; ## Suppress used only once warning. my %seen; # Jump as far down the directory hierarchy as we can. # Ideally, we'd figure out if this is a file by adding ,v # and checking for it (here and in the Attic), but that's # not worth the hassle right now. It would save us some # work when pulling a file out of the top of a big dir tree, # though. ( my $start = $spec ) =~ s{(^|/+)[^/]*(\*|\?|\.\.\.).*}{}; warn "$spec<<\n$start<<\n"; if ( -f "$start,v" ) { push @files, $start; $self->get_revs_from_rcs_file( $start ); goto SKIP_FILE_FIND; } while ( length $start && ! -d $start ) { last unless $start =~ s{/+[^/]*\z}{}; } $spec = substr( $spec, length $start ); $spec =~ s{^[\\/]+}{}g; warn "$spec<<2\n$start<<2\n"; my $pat = compile_shellish $spec, { star_star => 0 }; print STDERR "vcp: scanning $root/$start/... for $pat: "; $start = "." unless length $start && -d $start; File::Find::find( { no_chdir => 1, wanted => sub { warn $_; if ( /CVSROOT\z/ ) { $File::Find::prune = 1; return; } return if -d; warn $_; s/^\.\///; return unless s/,v\z//; if ( -f _ && $_ =~ $pat ) { ( my $undeleted_path = $_ ) =~ s/(\/)Attic\//$1/; if ( $seen{$undeleted_path}++ ) { warn "\nvcp: scanner found $undeleted_path again\n"; return; } eval { $self->get_revs_from_rcs_file( $_ ); 1; } or do { print STDERR "\n"; die "$@ for $_\n"; }; push @files, $_; } unless ( $hash_count++ % 50 ) { my $t = time; if ( $t > $hash_time + 5 ) { $hash_time = $t; print STDERR "#"; } } }, }, $start ); SKIP_FILE_FIND: print STDERR "\nvcp: found ", 0+@files, " files, ", 0+$self->revs->get, " revs\n"; chdir $cwd or die "$!: $cwd"; return \@files; } { my $special = "\$,.:;\@"; my $idchar = "[^\\s$special\\d\\.]"; # Differs from man rcsfile(1) my $num_re = "[0-9.]+"; my $id_re = "(?:(?:$num_re)?$idchar(?:$idchar|$num_re)*)"; my %id_map = ( # RCS file => "cvs log" (& its parser) field name changes "log" => "comment", "expand" => "keyword", ); sub _xdie { my ( $path, $line, $buffer ) = reverse ( pop, pop, pop ); # $buffer = substr( $buffer, 0, 100 ) . "'...'" . substr( $buffer, -100 ) # if length $buffer > 205; $buffer =~ s/\n/\\n/g; $buffer =~ s/\r/\\r/g; print STDERR "\n"; die "vcp: ", @_, " in RCS file $path, near line $line: '$buffer'\n"; } sub get_revs_from_rcs_file { my $self = shift; my ( $file ) = @_; require File::Spec::Unix; my $path = File::Spec::Unix->canonpath( $self->cvsroot . "/" . $file . ",v" ); open F, "<$path" or die "$!: $path\n"; binmode F; my $buffer; my $rev_id; # undef => in admin section, defined => in deltas section # (note: that's the first deltas section, not the # one with the actual text of the deltas.) my $file_data = { rcs => $path, working => $file, }; my $rev_data; my @ordered_revs; my $ln = 0; my $ok_ln = 0; local $_; LOOP: while ( ! defined $buffer || length $buffer ) { my $count = read( F, $buffer, length $buffer + 1_000_000 ); _xdie "$!: ", $path, $ok_ln, $buffer unless defined $count; warn ">>", $_; ++$ln; $ok_ln = $ln; $buffer .= $_; next LOOP unless $buffer =~ /\S\s/; # rcsfiles are # speced to end in \n., # so that trailing \s is ok $buffer =~ s/^\s+//; my $id; if ( $buffer =~ s/\A($id_re)\s*//o ) { $id = $1; $DB::single = 1 if $id eq "desc"; warn "id=$id"; } elsif ( $buffer =~ s/\A($num_re)\s*//o ) { $rev_id = $1; my $is_new = ! exists $rev_data->{$rev_id}; $rev_data->{$rev_id}->{rev_id} = $rev_id; push @ordered_revs, $rev_data->{$rev_id} if $is_new; next LOOP; } else { _xdie "expected an identifier", $path, $ok_ln, $buffer; } _xdie "$id should not have been parsed as an identifier", $path, $ok_ln, $buffer if $id =~ /\A$num_re\z/o; until ( $buffer =~ /\S/ ) { die "unexected end of", $path, $ok_ln, $buffer unless defined( $_ = ); ++$ln; $buffer .= $_; } my $value; if ( substr( $buffer, 0, 1 ) eq ";" ) { $buffer =~ s/\A;\s*//; $value = ""; } elsif ( substr( $buffer, 0, 1 ) eq '@' ) { # It's an RCS string (@...@) substr( $buffer, 0, 1 ) = ""; $value = ""; while (1) { # match, very carefully, an @ that's after 0,2,... @s and # not before an @, requiring that the string be at least one # character longer than an @. RCS files are required to # end in a newline, so we can depend on having a char # after the @. # This awkward double step is to work around a # segfault in perl5.6.{0,1} and perl5.8.0 while ( $buffer =~ s/\A((?:[^\@]*(?:\@\@)*)*)(?=.|\z)// ) { last unless length $1; $value .= $1; last unless length $buffer; } if ( length $buffer && $buffer =~ s/\A([^\@]*)\@(?=[^\@])//s ) { $value .= $1; last; } if ( substr( $buffer, -1 ) ne "@" ) { $value .= $buffer; $buffer = ""; } _xdie "failed to parse string value for field '$id'", $path, $ok_ln, $buffer unless read F, $_, 1_000_000; $ln += tr/\n//; $buffer .= $_; } # trim trailing whitespace and optional semicolon while (1) { last if $buffer =~ s/\A\s*;?(?=.)//s; $_ = ; last unless defined $_; ++$ln; $buffer .= $_; } _xdie "odd number of '\@'s in RCS string for field '$id'", $path, $ok_ln, $value if ( $value =~ tr/\@// ) % 2; $value =~ s/\@\@/\@/g; } else { # Not a string, so it's semicolon delimited and # we can ignore leading/trailing whitespace. while (1) { if ( $buffer =~ s/\A\s*(.*?)\s*;//s ) { $value = $1; last; } _xdie "failed to parse value for field '$id'", $path, $ok_ln, $buffer unless defined( $_ = ); ++$ln; $buffer .= $_; } } _xdie "expected a value", $path, $ok_ln, $buffer unless defined $value; $id = $id_map{$id} if exists $id_map{$id}; unless ( defined $rev_id ) { _xdie "already assigned '$file_data->{$id}' to $id, can't assign '$value'", $path, $ok_ln, $buffer if exists $file_data->{$id}; if ( $id eq "symbols" ) { for ( split /\s+/, $value ) { my ( $tag, $rev ) = split /:/, $_, 2; push @{$file_data->{RTAGS}->{$rev}}, $tag; $self->branches->add( VCP::Branch->new( branch_id => $tag ) ) if $rev =~ /\.0\.\d+\z/; } } else { $file_data->{$id} = $value; } } else { # text is big and should be saved to a temp file or # marked for later seek()ing if not metadata_only().. $rev_data->{$rev_id}->{$id} = $value unless $id eq "text"; } warn "HEY"; } close F; $file_data->{keyword} = "" unless defined $file_data->{keyword}; for ( values %$rev_data ) { use BFD q($_); my $r = $self->_fill_in_rev( $file_data, $_ ); $self->revs->add( $r ); } for ( values %$rev_data ) { $_->{rev_id} =~ /\A([\d.]+)\.(\d+)\z/ or die "can't parse $_->{rev_id}"; my $prev_id; if ( $2 >= 2 ) { $prev_id = "/$file#$1." . ( $2 - 1 ); } elsif ( 0 <= index $1, "." and $2 == 1 ) { ( $prev_id = "/$file#$1" ) =~ s/\.[^.]+\z//; } if ( defined $prev_id ) { my $id = "/$file#$_->{rev_id}"; my $r = $self->revs->get( $id ); my $pr = $self->revs->get( $prev_id ); $r->previous_id( $prev_id ); $r->previous( $pr ) ; } } } } sub get_revs_direct { my $self = shift; my $files = $self->get_matching_files_direct; } sub copy_revs { my VCP::Source::cvs $self = shift ; if ( $use_cache && -f "cvs.cache" ) { print STDERR "vcp: loading cvs.cache...\n"; my $old_revs = do "cvs.cache"; die $! unless defined $old_revs; die $VCP::Source::cvs::foo unless $VCP::Source::cvs::foo; $self->revs( $VCP::Source::cvs::foo ); print STDERR "vcp: read ", 0+$self->revs->get, " revs from cvs.cache\n"; } else { if ( $self->{CVS_DIRECT} ) { $self->get_revs_direct; } else { $self->get_revs_from_log_file; } } if ( ( $use_cache && ! -f "cvs.cache" ) || $build_cache ) { open F, ">cvs.cache" or die $!; require Data::Dumper; $Data::Dumper::Purity = 1; print F Data::Dumper->Dump( [ $self->revs], [ "foo" ] ); close F; } print STDERR "vcp: sorting revisions\n"; my $start_time; if ( $time_sort ) { require Time::HiRes; $start_time = Time::HiRes::time() if $time_sort; enable_debug( "VCP::Dest" ); } $self->dest->sort_revs( $self->revs ) ; if ( $time_sort ) { my $diff = Time::HiRes::time() - $start_time; my $mins = int $diff / 60; printf STDERR "vcp: sort took %2d:%06.3f\n", $mins, $diff - $mins * 60; } my $metadata_only = $self->dest->metadata_only; my VCP::Rev $r ; print STDERR "vcp: copying revisions\n"; while ( $r = $self->revs->shift ) { $self->get_rev( $r ) unless $metadata_only || ( $r->action || "" ) eq "delete"; $self->dest->handle_rev( $r ) ; } } # Here's a typical file log entry. # ############################################################################### # #RCS file: /var/cvs/cvsroot/src/Eesh/Changes,v #Working file: src/Eesh/Changes #head: 1.3 #branch: #locks: strict #access list: #symbolic names: # Eesh_003_000: 1.3 # Eesh_002_000: 1.2 # Eesh_000_002: 1.1 #keyword substitution: kv #total revisions: 3; selected revisions: 3 #description: #---------------------------- #revision 1.3 #date: 2000/04/22 05:35:27; author: barries; state: Exp; lines: +5 -0 #*** empty log message *** #---------------------------- #revision 1.2 #date: 2000/04/21 17:32:14; author: barries; state: Exp; lines: +22 -0 #Moved a bunch of code from eesh, then deleted most of it. #---------------------------- #revision 1.1 #date: 2000/03/24 14:54:10; author: barries; state: Exp; #*** empty log message *** #============================================================================= ############################################################################### sub _store_rev { my $self = shift; return unless keys %{$self->{CVS_LOG_REV}} ; $self->{CVS_LOG_REV}->{comment} = '' if $self->{CVS_LOG_REV}->{comment} eq '*** empty log message ***' ; $self->{CVS_LOG_REV}->{comment} =~ s/\r\n|\n\r/\n/g ; #debug map "$_ => $self->{CVS_LOG_FILE_DATA}->{$_},", sort keys %{$self->{CVS_LOG_FILE_DATA}} ; my $r = $self->_fill_in_rev( $self->{CVS_LOG_FILE_DATA}, $self->{CVS_LOG_REV} ) ; $self->{CVS_LOG_REV} = {} ; my $ok = eval { my $nr = $self->revs->get_last_added( $r ) ; $nr->previous_id( $r->id ) ; $nr->previous( $r ) ; 1 ; } ; die $@ unless $ok || 0 < index $@, "t find revision"; $r->previous( $self->revs->get( $r->previous_id ) ) if defined $r->previous_id; $ok = eval { $self->revs->add( $r ) ; 1 ; } ; unless ( $ok ) { if ( $@ =~ /Can't add same revision twice/ ) { warn $@ ; } else { die $@ ; } } } sub parse_log_file { my ( $self, $input ) = @_ ; if ( defined $input ) { $self->{CVS_LOG_CARRYOVER} .= $input ; } else { ## There can only be leftovers if they don't end in a "\n". I've never ## seen that happen, but given large comments, I could be surprised... $self->{CVS_LOG_CARRYOVER} .= "\n" if length $self->{CVS_LOG_CARRYOVER} ; } local $_ ; ## DOS, Unix, Mac lineends spoken here. while ( $self->{CVS_LOG_CARRYOVER} =~ s/^(.*(?:\r\n|\n\r|\n))// ) { $_ = $1 ; ## [1] See bottom of file for a footnote explaining this delaying of ## clearing CVS_LOG_FILE_DATA and CVS_LOG_STATE until we see ## a ========= line followed by something other than a ----------- ## line. ## TODO: Move to a state machine design, hoping that all versions ## of CVS emit similar enough output to not trip it up. ## TODO: BUG: Turns out that some CVS-philes like to put text ## snippets in their revision messages that mimic the equals lines ## and dash lines that CVS uses for delimiters!! PLEASE_TRY_AGAIN: if ( /^===========================================================*$/ ) { $self->_store_rev;# "is oldest" ) ; $self->{CVS_SAW_EQUALS} = 1 ; next ; } if ( /^----------------------------*$/ ) { $self->_store_rev unless $self->{CVS_SAW_EQUALS} ; $self->{CVS_SAW_EQUALS} = 0 ; $self->{CVS_LOG_STATE} = 'rev' ; next ; } if ( $self->{CVS_SAW_EQUALS} ) { $self->{CVS_LOG_FILE_DATA} = {} ; $self->{CVS_LOG_STATE} = '' ; $self->{CVS_SAW_EQUALS} = 0 ; } unless ( $self->{CVS_LOG_STATE} ) { if ( /^(RCS file|Working file|head|branch|locks|access list|keyword substitution):\s*(.*)/i ) { #warn lc( (split /\s+/, $1 )[0] ), "/", $1, ": ", $2, "\n" ; $self->{CVS_LOG_FILE_DATA}->{lc( (split /\s+/, $1 )[0] )} = $2 ; #$DB::single = 1 if /keyword/ && $self->{CVS_LOG_FILE_DATA}->{working} =~ /Makefile/ ; } elsif ( /^total revisions:\s*([^;]*)/i ) { # $self->{CVS_LOG_FILE_DATA}->{TOTAL} = $1 ; # if ( /selected revisions:\s*(.*)/i ) { # $self->{CVS_LOG_FILE_DATA}->{SELECTED} = $1 ; # } } elsif ( /^symbolic names:/i ) { $self->{CVS_LOG_STATE} = 'tags' ; next ; } elsif ( /^description:/i ) { $self->{CVS_LOG_STATE} = 'desc' ; next ; } else { carp "Unhandled CVS log line '$_'" if /\S/ ; } } elsif ( $self->{CVS_LOG_STATE} eq 'tags' ) { if ( /^\S/ ) { $self->{CVS_LOG_STATE} = '' ; goto PLEASE_TRY_AGAIN ; } my ( $tag, $rev ) = m{(\S+):\s+(\S+)} ; unless ( defined $tag ) { carp "Can't parse tag from CVS log line '$_'" ; $self->{CVS_LOG_STATE} = '' ; next ; } # not actually needed # $self->{CVS_LOG_FILE_DATA}->{TAGS}->{$tag} = $rev ; push( @{$self->{CVS_LOG_FILE_DATA}->{RTAGS}->{$rev}}, $tag ) ; $self->branches->add( VCP::Branch->new( branch_id => $tag ) ) if $rev =~ /\.0\.\d+\z/; } elsif ( $self->{CVS_LOG_STATE} eq 'rev' ) { ( $self->{CVS_LOG_REV}->{rev_id} ) = m/([\d.]+)/ ; $self->{CVS_LOG_STATE} = 'rev_meta' ; next ; } elsif ( $self->{CVS_LOG_STATE} eq 'rev_meta' ) { for ( split /;\s*/ ) { my ( $key, $value ) = m/(\S+):\s+(.*?)\s*$/ ; $self->{CVS_LOG_REV}->{lc($key)} = $value ; } $self->{CVS_LOG_STATE} = 'rev_message' ; next ; } elsif ( $self->{CVS_LOG_STATE} eq 'rev_message' ) { $self->{CVS_LOG_REV}->{comment} .= $_ unless /\Abranches: .*;$/; } } ## Never, ever forget the last rev. "Wait for me! Wait for me!" ## Most of the time, this should not be a problem: cvs log puts a ## line of "=" at the end. But just in case I don't know of a ## funcky condition where that might not happen... unless ( defined $input ) { $self->_store_rev() ; $self->{CVS_LOG_REV} = undef ; $self->{CVS_LOG_FILE_DATA} = undef ; } } # Here's a (probably out-of-date by the time you read this) dump of the args # for _fill_in_rev: # ############################################################################### #$file = { # 'WORKING' => 'src/Eesh/eg/synopsis', ## 'SELECTED' => '2', # 'LOCKS' => 'strict', ## 'TOTAL' => '2', # 'ACCESS' => '', # 'RCS' => '/var/cvs/cvsroot/src/Eesh/eg/synopsis,v', # 'KEYWORD' => 'kv', # 'RTAGS' => { # '1.1' => [ # 'Eesh_003_000', # 'Eesh_002_000' # ] # }, # 'HEAD' => '1.2', ### 'TAGS' => { <== not used, so commented out. ### 'Eesh_002_000' => '1.1', ### 'Eesh_003_000' => '1.1' ### }, # 'BRANCH' => '' #}; #$rev = { # 'DATE' => '2000/04/21 17:32:16', # 'comment' => 'Moved a bunch of code from eesh, then deleted most of it. #', # 'STATE' => 'Exp', # 'AUTHOR' => 'barries', # 'REV' => '1.1' #}; ############################################################################### sub _fill_in_rev { my VCP::Source::cvs $self = shift ; my ( $file_data, $rev_data, $is_base_rev ) = @_ ; $file_data->{working} =~ s{([\\/])[\\/]+}{$1}g; my $norm_name = $self->normalize_name( $file_data->{working} ) ; my $action = $rev_data->{state} eq "dead" ? "delete" : "edit" ; my $type = $file_data->{keyword} =~ /[o|b]/ ? "binary" : "text" ; debug map "$_ => $rev_data->{$_}, ", sort keys %{$rev_data} if debugging $self; my $rev_id = $rev_data->{rev_id}; my $branch_id; my $previous_id; if ( $rev_id =~ /\A(\d+(?:\.\d+)+)\.(\d+)\.(\d+)\z/ ) { $previous_id = $self->denormalize_name( $norm_name ) . "#$1" if $3 eq "1"; my $magic_branch_number = "$1.0.$2"; $branch_id = exists $file_data->{RTAGS}->{$magic_branch_number} ? $file_data->{RTAGS}->{$magic_branch_number}->[0] : do { my $invented_tag = "_branch_$magic_branch_number"; # TODO: Consider what happens if two files brancehd # at the same revision number but aren't really in the # same branch. # # Also: consider doing invented branch consolidation # for files that branched around the same time. $self->branches->add( VCP::Branch->new( branch_id => $invented_tag ) ); $invented_tag; } } elsif ( ( $rev_id =~ tr/.// ) > 1 ) { die "Did not parse ${rev_id}'s branch number"; } my VCP::Rev $r = VCP::Rev->new( id => $self->denormalize_name( $norm_name ) . "#$rev_id", source_name => $file_data->{working}, name => $norm_name, rev_id => $rev_id, type => $type, action => $action, time => $self->parse_time( $rev_data->{date} ), user_id => $rev_data->{author}, comment => $rev_data->{comment}, state => $rev_data->{state}, labels => $file_data->{RTAGS}->{$rev_id}, branch_id => $branch_id, $action ne "delete" ? ( previous_id => $previous_id ) : (), ) ; $self->{CVS_NAME_REP_NAME}->{$file_data->{working}} = $file_data->{rcs} ; return $r; } ## FOOTNOTES: # [1] :pserver:guest@cvs.tigris.org:/cvs hass some goofiness like: #---------------------------- #revision 1.12 #date: 2000/09/05 22:37:42; author: thom; state: Exp; lines: +8 -4 # #merge revision history for cvspatches/root/log_accum.in #---------------------------- #revision 1.11 #date: 2000/08/30 01:29:38; author: kfogel; state: Exp; lines: +8 -4 #(derive_subject_from_changes_file): use \t to represent tab #characters, not the incorrect \i. #============================================================================= #---------------------------- #revision 1.11 #date: 2000/09/05 22:37:32; author: thom; state: Exp; lines: +3 -3 # #merge revision history for cvspatches/root/log_accum.in #---------------------------- #revision 1.10 #date: 2000/07/29 01:44:06; author: kfogel; state: Exp; lines: +3 -3 #Change all "Tigris" ==> "Helm" and "tigris" ==> helm", as per Daniel #Rall's email about how the tigris path is probably obsolete. #============================================================================= #---------------------------- #revision 1.10 #date: 2000/09/05 22:37:23; author: thom; state: Exp; lines: +22 -19 # #merge revision history for cvspatches/root/log_accum.in #---------------------------- #revision 1.9 #date: 2000/07/29 01:12:26; author: kfogel; state: Exp; lines: +22 -19 #tweak derive_subject_from_changes_file() #============================================================================= #---------------------------- #revision 1.9 #date: 2000/09/05 22:37:13; author: thom; state: Exp; lines: +33 -3 # #merge revision history for cvspatches/root/log_accum.in # =head1 SEE ALSO L, L, L. =head1 AUTHOR Barrie Slaymaker =head1 COPYRIGHT Copyright (c) 2000, 2001, 2002 Perforce Software, Inc. All rights reserved. See L (C) for the terms of use. =cut 1