package VCP::Source::vss ; =head1 NAME VCP::Source::vss - A VSS repository source =head1 SYNOPSIS vcp vss:project/... =head1 DESCRIPTION Source driver enabling L|vcp> to extract versions form a vss repository. The source specification for VSS looks like: vss:filespec [] C may contain trailing wildcards, like C to extract an entire directory tree (this is the normal case). NOTE: This does not support incremental exports, see LIMITATIONS. =head1 OPTIONS =over =item --cd Used to set the VSS working directory. VCP::Source::vss will cd to this directory before calling vss, and won't initialize a VSS workspace of it's own (normally, VCP::Source::vss does a "vss checkout" in a temporary directory). This is an advanced option that allows you to use a VSS workspace you establish instead of letting vcp create one in a temporary directory somewhere. This is useful if you want to read from a VSS 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. =cut #=item -V # # -V 5 # -V 5~3 # #Passed to C. =back =head2 Files that aren't tagged VSS 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 Many and various. VSS, aside from its "normal" level of database corruption that many sites either deal with regularly or manage to ignore, also has many reporting and, from what I can tell, data model flaws that make it challenging to figure out what happened when. =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 File::Basename; use Regexp::Shellish qw( :all ) ; use VCP::Rev ; use VCP::Debug qw(:debug ); use VCP::Logger qw( lg pr BUG pr_doing pr_done ); use VCP::Source ; use VCP::Utils qw( escape_filename empty start_dir_rel2abs ); use VCP::Utils::vss ; use base qw( VCP::Source VCP::Utils::vss ) ; use fields ( 'VSS_CUR', ## The current change number being processed 'VSS_IS_INCREMENTAL', ## Hash of filenames, 0->bootstrap, 1->incremental 'VSS_INFO', ## Results of the 'vss --version' command and VSSROOT 'VSS_LABEL_CACHE', ## ->{$name}->{$rev} is a list of labels for that rev 'VSS_LABELS', ## Array of labels from 'p4 labels' 'VSS_MAX', ## The last change number needed 'VSS_MIN', ## The first change number needed # 'VSS_WORK_DIR', ## working directory set via --cd option 'VSS_VER_SPECS', ## An ARRAY of revision specs to pass to ## `ss History`. undef if there are none. 'VSS_NAME_REP_NAME', ## A mapping of names to repository names 'VSS_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). 'VSS_HIGHEST_VERSION', ## A HASH keyed on filename that contains the ## last rev_id seen for a file. This allows ## file deletions (which aren't tracked by ## VSS in a file's history) to be given a ## pretend revision number. This value includes ## any VSS revisions we ignore because they ## are merely label actions. 'VSS_HIGHEST_REVML_VERSION', ## This is like VSS_HIGHEST_VERSION but ## does *not* include the ignored VSS revisions. ## So it will be smaller than VSS_HIGHEST_VERSION ## whenever labels are involved. 'VSS_REV_ID_OFFSET', ## After a busy day processing a deleted file, ## it's time to relax and process the not-deleted ## file of the same name. In order to keep ## from reusing the same version numbers for ## the not-deleted file, this variable contains ## an offset to add to the revisions. It's the ## value of VSS_HIGHEST_VERSION reached while ## reading the deleted file. 'VSS_CURRENT_PROJECT', ## The last ss cp parameter we issued. 'VSS_FILES', ## We need to scan VSS for a list of files so we ## can do wildcard processing. This is done with ## a VCP::FilesDB object. 'VSS_BRANCHED_FROM', ## Cache of what files are branched from what ## other files. Each HASH key is an absolute ## VSS path to a file in lowercase. ## Each element is a ## RevML id (/path/to/file#5) of the parent ## version. ## Log file parsing state. 'VSS_LOG_FILE_DATA', ## The data that applies to the file for which ## the history log is being parsed. 'VSS_LOG_REV_DATA', ## Multiple VSS revisions can get compressed ## in to a single VCP revision in order to ## associate labels with the last actually ## changed version. To do this, the parser ## keeps accumulating data in this HASH ## until it finds a revision with an action ## other than "Labeled". The parser works ## from most recent revision to oldest and, ## may need to go past a revision specification ## that was given on the command line. This ## is a class data member so that repeated calls ## to the history command may be made to find ## a committable offense. 'VSS_LOG_OLDEST_VERSION', ## The oldest rev parsed for this file. ) ; sub new { my $class = shift ; $class = ref $class || $class ; my VCP::Source::vss $self = $class->SUPER::new( @_ ) ; ## Parse the options my ( $spec, $options ) = @_ ; unless ( empty $spec ) { ## Make it look like a Unix path. $spec =~ s{^\$//}{}; $spec =~ s{\$}{}g; $spec =~ s{\\}{/}g; $self->parse_vss_repo_spec( $spec ); } $self->parse_options( $options ); return $self ; } #sub options_spec { # my VCP::Source::vss $self = shift; # return ( # $self->SUPER::options_spec, # "cd=s" => \$self->{VSS_WORK_DIR}, # "V=s" => sub { # shift; # push @{$self->{VSS_VER_SPECS}}, "-V" . shift if @_; # return map substr( $_, 2 ), @{$self->{VSS_VER_SPECS}}; # }, # ); #} sub init { my VCP::Source::vss $self= shift ; $self->SUPER::init; my $files = $self->repo_filespec ; $self->deduce_rev_root( $files ) unless defined $self->rev_root; ## Don't normalize the filespec. $self->repo_filespec( $files ) ; # my $work_dir = $self->{VSS_WORK_DIR}; # unless ( defined $work_dir ) { $self->create_vss_workspace ; # } # else { # $self->work_root( start_dir_rel2abs $work_dir ) ; # $self->command_chdir( $self->work_path ) ; # } { ## Dirty trick: send a known bad parm *just* to get ss.exe to ## print it's banner without popping open a help screen. ## we capture and ignore stderr because it's expected. $self->ss( [ "help", "/illegal arg" ], undef, \my $out, \my $ignored_err, { ok_result_codes => [0..255], }, ); $self->{VSS_INFO} = $out; } $self->files->delete_db; $self->files->open_db; } =item files Returns a reference to the FilesDB for this backend and repository. Creates an empty one if need be. This is like VCP::Dest::files() but most other sources do not need to do this, so these are =cut sub files { my VCP::Source::vss $self = shift ; return $self->{VSS_FILES} ||= do { require VCP::FilesDB; $self->{VSS_FILES} = VCP::FilesDB->new( TableName => "source_files", StoreLoc => $self->_db_store_location, ); } } sub is_incremental { my VCP::Source::vss $self= shift ; my ( $file, $first_rev ) = @_ ; $first_rev =~ s/\.\d+//; ## Trim down rev_ids my $bootstrap_mode = $first_rev <= 1 || $self->is_bootstrap_mode( $file ) ; return ! $bootstrap_mode ; } sub denormalize_name { my VCP::Source::vss $self = shift ; return '/' . $self->SUPER::denormalize_name( @_ ) ; } sub handle_header { my VCP::Source::vss $self = shift ; my ( $header ) = @_ ; $header->{rep_type} = 'vss' ; $header->{rep_desc} = $self->{VSS_INFO} ; $header->{rev_root} = $self->rev_root ; $self->dest->handle_header( $header ) ; return ; } sub get_rev { my VCP::Source::vss $self = shift ; my VCP::Rev $r ; ( $r ) = @_ ; die "can't check out ", $r->as_string, "\n" unless $r->is_base_rev || $r->action eq "add" || $r->action eq "edit"; my $wp = $self->work_path( "revs", $r->source_name, $r->source_rev_id ) ; $r->work_path( $wp ) ; $self->mkpdir( $wp ) ; my ( $fn, $dir ) = fileparse( $wp ); confess "Shouldn't be get_rev()ing a rev with no rev_id" unless defined $r->rev_id; if ( $self->vss_file_is_deleted( $r->vcp_source_scm_fn ) ) { my $rev_id = $r->rev_id; $rev_id -= $self->{VSS_REV_ID_OFFSET}->{$r->vcp_source_scm_fn} if $rev_id > $self->{VSS_REV_ID_OFFSET}->{$r->vcp_source_scm_fn}; $self->_swap_in_deleted_file_and( $r->vcp_source_scm_fn, "ss", [ "Get", "\$/" . $r->vcp_source_scm_fn, "-V" . $rev_id, "-GL" . $dir, "-GN", ## Newlines only, please ], ) ; } else { $self->ss( [ "Get", "\$/" . $r->vcp_source_scm_fn, "-V" . $r->rev_id, "-GL" . $dir, "-GN", ## Newlines only, please ], ); } my $temp_fn = fileparse( $r->vcp_source_scm_fn ); rename "$dir/$temp_fn", "$dir/$fn" or die "$! renaming $temp_fn to $fn\n"; return $wp; } ## History report Parser states ## The code below does things like grep for "commit" and "skip to next" ## in these strings. Plus, they make debug output easier to read. use constant SKIP_TO_NEXT => "skip to next"; use constant SKIP_TO_NEXT_COMMIT_AT_END => "skip to next and commit at end"; use constant ENTRY_START => "entry start"; use constant READ_ACTION => "read action"; use constant READ_COMMENT_AND_COMMIT => "read comment and commit"; use constant READ_REST_OF_COMMENT_AND_COMMIT => "read rest of comment and commit"; sub _get_file_metadata { my VCP::Source::vss $self = shift ; my ( $filename ) = @_; my $ss_fn = "\$/$filename"; my $filetype; $self->ss( [ "FileType", $ss_fn ], undef, \$filetype ); $filetype =~ s/\A.*\s(\S+)\r?\n.*/$1/ms or BUG "Can't parse filetype from '$filetype'"; $filetype = lc $filetype; my $tmp_f; my $result = 1; ## Clear the parser state. $self->{VSS_LOG_OLDEST_VERSION} = undef ; $self->{VSS_LOG_REV_DATA} = undef; $self->{VSS_LOG_FILE_DATA} = { Name => $filename, Type => $filetype, }; $self->ss( [ "History", "\$/$filename", @{$self->{VSS_VER_SPECS} || []} ], undef, sub { $self->parse_history_output( @_ ) }, $self->{VSS_VER_SPECS} ? ( stderr_filter => sub { my ( $err_text_ref ) = @_ ; $$err_text_ref =~ s{^Version not found\r?\n\r?}[$result = 0; '' ;]mei ; }, ) : () ); ## If the history ended on a "Labeled" rev, it will not have ## been saved off as a real rev yet. ## I think this should only happen if the -V ## option was used. $self->_add_rev_from_log_parser if $self->{VSS_LOG_REV_DATA}; ## If the oldest revision not found was not a branch founding ## revision, then VSS_LOG_OLDEST_VERSION will be set. my $oldest = $self->{VSS_LOG_OLDEST_VERSION}; if ( defined $oldest && $self->is_incremental( $filename, $oldest ) ) { debug "scanning back to base rev" if debugging; $oldest =~ s/\.\d+//; # ignore faked-up revs. ## Walk back and find the next real version (ie not a labelled ## version. This should exist in the destination repository, ## even if it's not the head revision. while ( --$oldest && $oldest ) { if ( $oldest <= $self->{VSS_REV_ID_OFFSET}->{$filename} ) { $self->_swap_in_deleted_file_and( $filename, "_parse_a_rev", $filename, $oldest ); } else { $self->_parse_a_rev( $filename, $oldest ); } if ( !$self->{VSS_LOG_REV_DATA} ) { ## Must have found a real edit. debug "converting to base_rev", $self->revs->as_array_ref->[-1]->as_string if debugging; $self->revs->as_array_ref->[-1]->base_revify; last; } } } if ( keys %{$self->{VSS_LOG_REV_DATA}} ) { require Data::Dumper; local $Data::Dumper::Indent = 1; local $Data::Dumper::Quotekeys = 0; local $Data::Dumper::Terse = 1; BUG( "Data left over from log parse\n", Data::Dumper::Dumper( $self->{VSS_LOG_REV_DATA} ) ); } return $result; } ## This routine is used once per operation so that the source file is ## deleted immediately after each operation so that the source repo ## is always put back in its proper state in case we exit between ## operations. This is inefficient, but conservative. ## TODO: Allow a fast-but-dangerous option to make this maintain state ## for each file and only clean up the repository at the end. sub _swap_in_deleted_file_and { my VCP::Source::vss $self = shift ; my ( $filename, $method, @args ) = @_; my $ss_fn = "\$/$filename"; my $ignored_stdout; my $renamed_active; if ( $self->vss_file_is_active( $filename ) ) { my $i = ""; while (1) { $renamed_active = "$ss_fn.vcp_bak$i"; # last unless $self->vss_file( $renamed_active ); warn map "$_\n", $self->files->keys; die $renamed_active; last unless $self->files->get( $renamed_active ); $i ||= 0; ++$i; } $self->ss( [ "Rename", $ss_fn, $renamed_active ] ); } my $result; my $ok = eval { $self->ss( [ "Recover", $ss_fn ], ); my $ok = eval { $result = $self->$method( @args ); 1 }; my $x = $@; $self->{VSS_REV_ID_OFFSET}->{$filename} = $self->{VSS_HIGHEST_VERSION}->{$filename} || 0; $ok = eval { $self->ss( [ "Delete", $ss_fn ] ); 1; } && $ok; $x = "" unless defined $x; die $x.$@ unless $ok; }; my $x = $@; if ( defined $renamed_active ) { my $myok = eval { $self->ss( [ "Rename", $renamed_active, $ss_fn ] ); 1; }; if ( ! $myok ) { $x .= $@; $ok = 0; }; } die $x unless $ok; return $result; } sub copy_revs { my VCP::Source::vss $self = shift ; ## Get a list of all files we need to worry about $self->get_vss_file_list( $self->repo_filespec ); $self->revs( VCP::Revs->new ) ; pr_doing "extracting VSS metadata: ", { Expect => 0+$self->vss_files, }; for my $filename ( $self->vss_files ) { pr_doing; $self->{VSS_REV_ID_OFFSET}->{$filename} = 0; my $found_deleted; if ( $self->vss_file_is_deleted( $filename ) ) { $found_deleted = $self->_swap_in_deleted_file_and( $filename, "_get_file_metadata", $filename ); my $vss_name = "/$filename"; my $norm_name = $self->normalize_name( $filename ); my $rev_id = "$self->{VSS_REV_ID_OFFSET}->{$filename}.1"; my $branch_id = (fileparse $vss_name )[1]; my VCP::Rev $r = VCP::Rev->new( id => "$vss_name#$rev_id", name => $norm_name, vcp_source_scm_fn => $filename, source_name => $norm_name, source_filebranch_id => $vss_name, branch_id => $branch_id, source_branch_id => $branch_id, source_repo_id => $self->repo_id, action => "delete", ## Make up a fictional rev number that will allow the ## receiver's sort algorithm to put this delete in the ## right place and that will be documented in the ## receiving repository as a label. rev_id => $rev_id, source_rev_id => $rev_id, ## Deletes are not logged, no user data, time, etc. previous_id => "$vss_name#$self->{VSS_HIGHEST_REVML_VERSION}->{$filename}" ) ; my $add_it = 1; if ( $self->continue && $self->dest ) { my $previous_rev_id = $self->dest->last_rev_in_filebranch( $self->repo_id, $vss_name, ); my $cmp = defined $previous_rev_id ? VCP::Rev->cmp_id( $previous_rev_id, $rev_id ) : -1; $add_it = $cmp < 0; } $self->revs->add( $r ) if $add_it; } my $found_active; if ( $self->vss_file_is_active( $filename ) ) { my $tmp_ver_spec; if ( $found_deleted ) { ## If we were looking for a specific version and found it ## back in the deleted time, make sure we also get all ## the revs from the active file. ## THIS ASSUMES WE'RE NOT SEARCHING FOR A RANGE. ## Can't local()ize a p-hash. $tmp_ver_spec = $self->{VSS_VER_SPECS}; $self->{VSS_VER_SPECS} = undef; } $found_active = $self->_get_file_metadata( $filename ); $self->{VSS_VER_SPECS} = $tmp_ver_spec if $found_deleted; } pr join " ", @{$self->{VSS_VER_SPECS}}, "did not match any revisions of $filename" if $self->{VSS_VER_SPECS} && ! ( $found_deleted || $found_active ); } pr_done; ## Link each revision to its previous revision with a reference ## by using the previous_id string to find the previous rev. for my $r ( $self->revs->get ) { next unless defined $r->previous_id; ## We assume that any unfound source branches are not wanted and ## that the user intends to export a branch without its roots. my $pr = eval { $self->revs->get( $r->previous_id ) }; if ( $pr ) { $r->previous( $pr ); } else { die $@ unless 0 < index $@, "t find revision"; $r->previous_id( undef ); } } $self->SUPER::copy_revs; } # Here's a typical history # ############################################################################### ##D:\src\vcp>ss history #History of $/90vss.t ... # #***************** Version 9 ***************** #User: Admin Date: 3/05/02 Time: 9:32 #readd recovered # #***** a_big_file ***** #Version 3 #User: Admin Date: 3/05/02 Time: 9:32 #Checked in $/90vss.t #Comment: comment 3 # # #***** binary ***** #Version 3 #User: Admin Date: 3/05/02 Time: 9:32 #Checked in $/90vss.t #Comment: comment 3 # # #***************** Version 8 ***************** #User: Admin Date: 3/05/02 Time: 9:32 #readd deleted # #***** binary ***** #Version 2 #User: Admin Date: 3/05/02 Time: 9:32 #Checked in $/90vss.t #Comment: comment 2 # # #***************** Version 7 ***************** #User: Admin Date: 3/05/02 Time: 9:32 #readd added # #***** a_big_file ***** #Version 2 #User: Admin Date: 3/05/02 Time: 9:32 #Checked in $/90vss.t #Comment: comment 2 # # #***************** Version 6 ***************** #User: Admin Date: 3/05/02 Time: 9:32 #$del added # #***************** Version 5 ***************** #User: Admin Date: 3/05/02 Time: 9:32 #binary added # #***************** Version 4 ***************** #User: Admin Date: 3/05/02 Time: 9:31 #$add added # #***************** Version 3 ***************** #User: Admin Date: 3/05/02 Time: 9:31 #a_big_file added # #***************** Version 2 ***************** #User: Admin Date: 3/05/02 Time: 9:31 #$a added # #***************** Version 1 ***************** #User: Admin Date: 3/05/02 Time: 9:31 #Created # # #D:\src\vcp>ss dir /r #$/90vss.t: #$a #$add #$del #a_big_file #binary #readd # #$/90vss.t/a: #$deeply # #$/90vss.t/a/deeply: #$buried # #$/90vss.t/a/deeply/buried: #file # #$/90vss.t/add: #f1 #f2 #f3 # #$/90vss.t/del: #f4 # #13 item(s) # #D:\src\vcp> # ############################################################################### sub _parse_a_rev { my ( $self, $fn, $rev_id ) = @_; $rev_id -= $self->{VSS_REV_ID_OFFSET}->{$fn} if $rev_id > $self->{VSS_REV_ID_OFFSET}->{$fn}; $self->ss( [ "History", "\$/$fn", "-V$rev_id", "-#1" ], undef, sub { $self->parse_history_output( @_ ) } ); ## If the history ended on a "Labeled" rev, it will not have ## been saved off as a real rev yet. ## I think this should only happen if the -V ## option was used. $self->_add_rev_from_log_parser if $self->{VSS_LOG_REV_DATA}; } ## Called each time a new revision is reached and there's no place to ## catch the information. sub _init_log_rev_data { my VCP::Source::vss $self = shift; debug "initializing new rev" if debugging; return $self->{VSS_LOG_REV_DATA} = { %{$self->{VSS_LOG_FILE_DATA}}, }; } sub _add_rev_from_log_parser { my ( $self ) = @_; debug "adding revision" if debugging; my $p = $self->{VSS_LOG_REV_DATA}; BUG "trying to add a revision when none was parsed" unless $p; $self->{VSS_LOG_REV_DATA} = undef; $p->{Comment} = '' unless defined $p->{Comment}; $p->{Comment} =~ s/\r\n|\n\r/\n/g ; chomp $p->{Comment}; chomp $p->{Comment}; $self->_add_rev( $p ); my $name = $p->{Name}; ## This is the version number without the additional label ## versions. my $v = $p->{Version}; $self->{VSS_HIGHEST_REVML_VERSION}->{$name} = $v if ! defined $self->{VSS_HIGHEST_REVML_VERSION}->{$name} || $v > $self->{VSS_HIGHEST_REVML_VERSION}->{$name}; $v += @{ $p->{Labels} || [] }; $self->{VSS_HIGHEST_VERSION}->{$name} = $v if ! defined $self->{VSS_HIGHEST_VERSION}->{$name} || $v > $self->{VSS_HIGHEST_VERSION}->{$name}; } sub parse_history_output { my VCP::Source::vss $self = shift; my ( $input ) = @_ ; my $state = SKIP_TO_NEXT; my $p = $self->{VSS_LOG_REV_DATA}; local $_ ; while ( <$input> ) { if ( debugging ) { my $foo = $_; chomp $foo; debug "[$foo] $state\n"; } if ( /^\*{17} Version (\d+) +\*{17}/ ) { $self->_add_rev_from_log_parser if $p && "commit" eq substr $state, -6; $state = ENTRY_START; $p = $self->_init_log_rev_data unless $self->{VSS_LOG_REV_DATA}; ## This will overwrite the newer/higher version number ## with the lower/older one until we reach the check-in ## we want $self->{VSS_LOG_OLDEST_VERSION} = $p->{Version} = $1; next; } if ( /^\*{5}\s+(.*?)\s+\*{5}$/ ) { $self->_add_rev_from_log_parser if $p && "commit" eq substr $state, -6; $state = ENTRY_START; $p = $self->_init_log_rev_data unless $self->{VSS_LOG_REV_DATA}; next; } next if 0 == index $state, SKIP_TO_NEXT; if ( $state eq ENTRY_START ) { if ( /^User:\s+(.*?)\s+Date:\s+(.*?)\s+Time:\s+(\S+)/ ) { ## Store these aside in case they're for the next VCP::Rev ## (which we can only tell when reading the action). $p->{User}= $1; $p->{Date}= $2; $p->{Time}= $3; $state = READ_ACTION; next; } if ( /^Label:\s*"([^"]+)"/ ) { ## Unshift because we're reading from newest to oldest yet ## we want oldest first so vss->vss is relatively consistent unshift @{$p->{Labels}}, $1; next; } } if ( $state eq READ_ACTION ) { if ( /Labeled/ ) { ## It's a label-add only, ignore the rest. ## for incremental exports, we'll need to commit at the ## end of the log if the last thing was a "Labeled" ## version. We don't want to commit after each "Labeled" ## because we want to aggregate labels. $state = SKIP_TO_NEXT_COMMIT_AT_END; next; } if ( /Rolled back/ ) { ## This could be any number of things: ## * Rollback ## * Rollback-before-Branch ## * Share -V ## * Share -V followed by Branch ## We should figure out which one, but I'm not sure ## how to differentiate these. For now, I'm assuming ## that it's a branch creation. my $previous_id = eval { $self->branched_from( '$/' . $p->{Name} ) }; if ( $previous_id ) { ## Guess that it's a branch operation that VSS is hiding ## from us. Hope the user didn't *really* issue a ## Rollback. pr "assuming Rollback on branch is Branch point\n", " Parent: \$$previous_id\n", " Child: \$/$p->{Name}#$p->{Version}"; $p->{PreviousId} = $previous_id; goto BranchFound; } $state = SKIP_TO_NEXT_COMMIT_AT_END; next; } if ( /Branched/ ) { $state = SKIP_TO_NEXT_COMMIT_AT_END; $p->{PreviousId} = $self->branched_from( '$/' . $p->{Name} ); BranchFound: $p->{Action} = "placeholder"; delete $p->{Type}; ## Prevent the caller from searching back for a base ## revision. ## TODO: Allow a project with branched files to be extracted ## with the branch point being bootstrapped. $self->{VSS_LOG_OLDEST_VERSION} = undef; ## Ignore all history before the branch, it's just ## bleedthrough from the parent. ## TODO: deal properly with shared history before a branch. ## This may require noting the branch point and scrolling ## back to the beginning creating placeholders over and ## over again as we do with dual-labelled CVS file branches. return; } if ( /^(Checked in .*|Created|.* recovered)\r?\n/ ) { $state = READ_COMMENT_AND_COMMIT; $p->{Action} = "edit"; next; } } if ( $state eq READ_COMMENT_AND_COMMIT ) { if ( s/Comment: // ) { $p->{Comment} = $_; $state = READ_REST_OF_COMMENT_AND_COMMIT; next; } next unless /\S/; } if ( $state eq READ_REST_OF_COMMENT_AND_COMMIT ) { $p->{Comment} .= $_; next; } require Data::Dumper; local $Data::Dumper::Indent = 1; local $Data::Dumper::Quotekeys = 0; local $Data::Dumper::Terse = 1; BUG "unhandled VSS log line '$_' in state '$state' for:\n", Data::Dumper::Dumper( \%$p ); } $self->_add_rev_from_log_parser if 0 <= index $state, "commit"; } # Here's a (probably out-of-date by the time you read this) dump of the args # for _add_rev: # ############################################################################### #$file = { # 'WORKING' => 'src/Eesh/eg/synopsis', # 'SELECTED' => '2', # 'LOCKS' => 'strict', # 'TOTAL' => '2', # 'ACCESS' => '', # 'RCS' => '/var/vss/vssroot/src/Eesh/eg/synopsis,v', # 'KEYWORD' => 'kv', # 'RTAGS' => { # '1.1' => [ # 'Eesh_003_000', # 'Eesh_002_000' # ] # }, # 'HEAD' => '1.2', # 'TAGS' => { # 'Eesh_002_000' => '1.1', # 'Eesh_003_000' => '1.1' # }, # 'BRANCH' => '' #}; #$rev = { # 'DATE' => '2000/04/21 17:32:16', # 'MESSAGE' => 'Moved a bunch of code from eesh, then deleted most of it. #', # 'STATE' => 'Exp', # 'AUTHOR' => 'barries', # 'REV' => '1.1' #}; ############################################################################### ## Each rev needs to be dealt with in one of three ways: ignore it, send ## it as a base revision, or send it as a new revision. This function ## decides which to do. Returns "base rev" if it needs to be sent as a ## base revision, some other TRUE value if it needs to be sent as-is, ## or a FALSE value if it should be ignored. sub _filter_rev { my VCP::Source::vss $self = shift ; my ( $vss_name, $filename, $rev_id, $action ) = @_; BUG "No destination set" unless $self->dest; return "send it" unless $self->continue; my $previous_rev_id = $self->dest->last_rev_in_filebranch( $self->repo_id, $vss_name, ); my $cmp = defined $previous_rev_id ? VCP::Rev->cmp_id( $rev_id, $previous_rev_id ) : 1; return "send it" if $cmp > 0; return undef if $cmp < 0; ## We may need to send it as a base rev: it was already sent over ## once, so we won't send it whole. If we're bootstrapping this ## file, we don't send a bootstrap. return undef if $self->is_bootstrap_mode( $filename ); ## If this is a placeholder revision, don't resend it no matter what. ## The branch has already been created at the destination if need be ## TODO: perhaps the placeholder's predecessor should be sent as ## a base rev? return undef if $action eq "placeholder"; return "base rev"; } sub _add_rev { my VCP::Source::vss $self = shift ; my ( $rev_data, $is_base_rev ) = @_ ; my $filename = $rev_data->{Name}; my $vss_name = "/$filename"; my $rev_id = $rev_data->{Version} + $self->{VSS_REV_ID_OFFSET}->{$filename}; my $action = $rev_data->{Action}; my $send_mode = $self->_filter_rev( $vss_name, $filename, $rev_id, $action ); return unless $send_mode; my $norm_name = $self->normalize_name( $filename ); my $branch_id = (fileparse $vss_name )[1]; $rev_data->{Type} ||= "text" if $action ne "placeholder"; my VCP::Rev $r = VCP::Rev->new( id => "$vss_name#$rev_id", vcp_source_scm_fn => $filename, name => $norm_name, source_name => $norm_name, source_filebranch_id => $vss_name, branch_id => $branch_id, source_branch_id => $branch_id, source_repo_id => $self->repo_id, rev_id => $rev_id, source_rev_id => $rev_id, previous_id => $rev_data->{PreviousId}, type => $rev_data->{Type}, $send_mode ne "base rev" ? ( action => $action, time => $self->parse_time( $rev_data->{Date} . " " . $rev_data->{Time} ), user_id => $rev_data->{User}, comment => $rev_data->{Comment}, state => $rev_data->{STATE}, labels => $rev_data->{Labels}, ) : (), ); $self->{VSS_NAME_REP_NAME}->{$rev_data->{Name}} = $rev_data->{RCS} ; my $nr = eval { $self->revs->get_last_added( $r ) }; if ( $nr ) { $nr->previous_id( $r->id ) ; } elsif ( 0 > index $@, "t find revision" ) { die $@; } eval { $self->revs->add( $r ) ; } ; if ( $@ ) { if ( $@ =~ /Can't add same revision twice/ ) { pr $@ ; } else { die $@ ; } } } sub branched_from { my VCP::Source::vss $self = shift ; my ( $filename ) = @_; BUG "filename for Paths '$filename' not absolute" unless $filename =~ m{^\$/}; my $lc_fn = lc $filename; $self->ss( [ "Paths", $filename ], undef, sub { $self->parse_paths_output( @_ ) }, ) unless exists $self->{VSS_BRANCHED_FROM}->{$lc_fn}; BUG "can't find parent for '$filename'" unless exists $self->{VSS_BRANCHED_FROM}->{$lc_fn}; return $self->{VSS_BRANCHED_FROM}->{$lc_fn}; } ## Output looks like: ## ## Showing development paths for $/revml2vss/main-branch-1/branched... ## ## bar ## $/revml2vss/main ## bar (Branched at version 4) ## $/foo ## ## branched (Branched at version 2) ## > $/revml2vss/main-branch-1 ## ## We ignore the ">" position indicator. ## ## sub parse_paths_output { my VCP::Source::vss $self = shift ; my ( $input ) = @_ ; my $l = <$input>; BUG "expected 'Showing development...' from Paths, not '$l'" unless $l =~ /^Showing development/; $l = <$input>; BUG "expected Paths output line 2 to be blank, not '$l'" unless $l =~ /^\r?\n/; my $last_indent_length = 0; my $parent_full_fn; my $cur_fn; my $cur_branched_at; my $first_full_fn; local $_ ; while ( <$input> ) { if ( debugging ) { my $foo = $_; chomp $foo; debug "[$foo]\n"; } next if /\A\s*\z/; my ( $indent, $content ) = /^(>?\s+)(\S.*?)\r?\n/ or BUG "in Path output, can't parse line '$_'"; my $cur_indent = length $indent; BUG "in Path output, unexpected outdent from $cur_indent to ", length $indent, " in '$_'" if $cur_indent < $last_indent_length; my $is_project = '$/' eq substr $content, 0, 2; if ( $cur_indent > $last_indent_length ) { $last_indent_length = $cur_indent; $parent_full_fn = $first_full_fn; $first_full_fn = undef; BUG "in Path output, expected filename, not project path '$content'" if $is_project; } if ( $is_project ) { ## Its a line showing a project the cur_fn is shared by. Often ## (as in the above example) a file is in only one project ## but a file may be linked in to two projects. $content =~ s/\r?\n\z//; my $cur_full_fn = "$content/$cur_fn"; $first_full_fn = $cur_full_fn unless defined $first_full_fn; ## The key is in VSS-ese, starts with '$'. The value is ## in RevML-ese, starts with '/'. if ( defined $cur_branched_at ) { $self->{VSS_BRANCHED_FROM}->{ lc $cur_full_fn } = substr "$parent_full_fn#$cur_branched_at", 1; debug lc $cur_full_fn, " branched from ", $self->{VSS_BRANCHED_FROM}->{ lc $cur_full_fn } if debugging; } } else { ## Must be another file branched from the same parent. ( $cur_fn, $cur_branched_at ) = $content =~ /\A(.*?\S)(?:\s+\(Branched at version (\d+)\))?\r?\z/ or BUG "in Path output, unable to parse chunk '$content'"; ## The "Branched at version" value is the version number in ## the child file that the branch was created at. The parent ## carries the preceding version number (we hope). $cur_branched_at-- if defined $cur_branched_at; } } } =head1 VSS NOTES We lose comments attached to labels: labels are added to the last "real" (ie non-label-only) revision and the comments are ignored. This can be changed, contact me. We assume a file has always been text or binary, don't think this is stored per-version in VSS. VSS does not track renames by version, so a previous name for a file is lost. VSS lets you add a new file after deleting an old one. This module renames the current file, restores the old one, issues its revisions, then deletes the old on and renames the current file back. In this case, the Cs from the current file start at the highest C for the deleted file and continue up. Looks for deleted files: recovers them if found just long enough to cope with them, then deletes them again. Repeatedly, if need be. NOTE: when recovering a deleted file and using it, the current version takes a "create the smallest window of opportunity to leave the source repository in an uncertain state" approach: it renames the not-deleted version (if any), restores the deleted one, does the History or Get, and then deletes it and renames the not-deleted version back. This is so that if something (the OS, the hardware, AC mains, or even VCP code) crashes, the source repository is left as close to the original state as is possible. This does mean that this module can issue many more commands than minimally necessary; perhaps there should be a --speed-over-safety option. No incremental export is supported. VSS' -V~Lfoo option, which says "all versions since this label" does not actually cause the C command to emit the indicated checkin. We'll need to make the history command much smarter to implement that. Haven't tested many real-world scenarios yet. =over =item * Share-ing a project =back =cut =head1 SEE ALSO 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