# 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+[^\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;