# This file implements the class "Change". Aside from the usual constructor # and accessors, there are get and put functions to allow "Change" objects # to be stored in files. # # A Change object is a reference to an array of the following form: # [ timestamp, author, change_description, changelist ], where changelist # is an array of "archive#revision" strings. # # For example, # [ 867467930, 'james', 'This is\nbogus.\n', # [ 'C:\sample\blah.__v#1.1', # 'C:\sample\spaced out.__v#1.4' ] # ]; # # The outside world does not need to know anything about this representation # other than the "archive#revision" standard representation; new takes a # hash which describes the change in the terms given above. For example, # $c = new Change( { 'timestamp' => 867467930, # 'author' => 'james', # 'change_description' => 'This is\nbogus.\n', # 'changelist' => [ 'C:\sample\blah.__v#1.1', # 'C:\sample\spaced out.__v#1.4' ] # } ); # # will create the example change given above. (Please be good and provide # all fields - remember, GIGO). # # Notes: # - it is ok for filenames to contain spaces, but not labels or author names # - it really is changelist, not change_list ("changelist" has a specific # meaning in Perforce) # - the example given shows revisions and archives from the system being # converted from; later stages map these to Perforce # # RHGC - Modified submit to improve error handling if someone else also # working on the depot at the same time (when changelists might be renamed). require 5.0; package Change; use strict; use vars qw(@ISA @EXPORT); use lib '.'; use convert; use integer; use Carp; use Time::Local; require Exporter; @ISA = qw(Exporter); @EXPORT = qw ( timestamp datetime author change_description changelist filelist new get unget finished put submit); sub timestamp { my ($self,$value)=@_; return (defined $value) ? $$self[0]=$value : $$self[0]; } sub datetime # Convert to date time { my $self = shift; my (@tm,$date); @tm=localtime($self->timestamp); $date=sprintf("%4d/%02d/%02d %02d:%02d:%02d",(($tm[5]>=70) ? $tm[5]+1900 : $tm[5]+2000), $tm[4]+1,$tm[3],$tm[2],$tm[1],$tm[0]); return $date; } sub author { my ($self,$value)=@_; return (defined $value) ? $$self[1]=$value : $$self[1]; } sub change_description { my ($self,$value)=@_; return (defined $value) ? $$self[2]=$value : $$self[2]; } sub changelist { # expects a reference to an array my ($self,$value)=@_; return (defined $value) ? $$self[3]=$value : $$self[3]; } sub filelist { my $self=shift; my @filelist = @{$$self[3]}; for (@filelist) { s/#.*$//; # strip off the revision number } return @filelist; } sub new { my ($class,$hash)=@_; my $change=bless [],$class; my $key; if(defined($hash)) { foreach $key (keys(%$hash)) { $change->$key( $$hash{$key} ); } } return $change; } my (%last_change,%ungotten); sub unget { my ($class,$input)=@_; croak "can only unget one item per stream" if(exists($ungotten{$input})); $ungotten{$input}=1; } # use finished rather than eof to see if you are finished reading changes # from a stream. finished takes unget into account sub finished { my ($class,$input)=@_; return (exists($ungotten{$input})) ? 0 : eof($input); } # get is an alternate constructor. Use "$change = Change::get(\*HANDLE)" # or "$change = get Change(\*HANDLE)". I didn't name this read because # the conflict with the standard Perl library function makes the second # syntactic form not parse correctly ("Not enough arguments for read..") sub get { my ($class,$input)=@_; my $line; return 0 if(!defined($input)); # filehandle argument is not optional # return item saved with unget if applicable if(exists($ungotten{$input})) { delete $ungotten{$input}; return $last_change{$input}; } # ok, do a real get my ($num_lines,$timestamp,$author,$change_description,@changelist); while( defined($line = <$input>) ) { chomp($line); last if(substr($line,0,1) eq '+'); push @changelist,$line; } return 0 if(!scalar(@changelist) || eof($input)); ($num_lines,$timestamp,$author) = split(/#/,$line); for($change_description=""; $num_lines>0; $num_lines--) { $change_description .= <$input>; } $author =~ s/ /_/g; # Make sure no spaces in username # just create the object right here rather than using the accessor functions return $last_change{$input} = bless [ $timestamp, $author, $change_description, [ @changelist ] ], $class; } sub put { my ($self,$output)=@_; return 0 if(!defined($output)); # filehandle argument is not optional my ($timestamp,$author,$change_description,$changelist) = @$self; my $num_lines = ($change_description =~ tr/\n//); my $changelist_entry; foreach $changelist_entry (@$changelist) { print $output $changelist_entry . "\n"; } print $output "+$num_lines#$timestamp#$author\n$change_description"; } sub submit { my $self = shift; my $change_description = $self->change_description; my ($form,$output,$change_number); $form=convert::p4run(" change -o"); if ($form =~ /\nFiles:/) { $change_description =~ s@\n@\n\t@gs; $form =~ s@\n\s+<enter description here>[^\n]*\n@\n\t$change_description\n@s; $output = convert::p4run(" submit -i",$form); # RHGC - Modified to use better checking - can get 2 potential results which are both successful if( $output !~ m/Change ([0-9]+) submitted.|Change ([0-9]+) renamed change ([0-9]+) and submitted./si ) { die "p4 submit aborted - conversion terminated. Output was:\n$output"; } # 2 forms of result - check for which one and extract the resulting change number. if( $output =~ m/Change ([0-9]+) submitted./si ) { $change_number = $1; } elsif ( $output =~ m/Change [0-9]+ renamed change ([0-9]+) and submitted./si ) { $change_number = $1; } # fix date, user on submitted change my $user = $self->author; my $date = $self->datetime; $form=convert::p4run(" change -o $change_number"); $form =~ s@\nDate:[^\n]*\n@\nDate: $date\n@s; $form =~ s@\nUser:[^\n]*\n@\nUser: $user\n@s; $output = convert::p4run(" change -i -f",$form); convert::log("Form:\n$form"); print "Change $change_number submitted.\r"; # running total.. } else { print "WARNING: Change $change_number empty.\r"; } return $change_number; # returns the change number } 1;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 7114 | Sven Erik Knop |
This is a modification of the public depot version of pvcsToP4. This version requires the official P4Perl release from the Perforce ftp site. The main change compared to the public depot release of pvcsToP4 is that this version supports branching - as far as I have been able to test - completely. Please see CHANGELOG and README for some details. |