# 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 "revision archive" strings.
#
# For example,
# [ 867467930, 'james', 'This is\nbogus.\n',
# [ '4 $/sample/blah',
# '3 $/sample/spaced out' ]
# ];
#
# The outside world does not need to know anything about this representation
# other than the "revision archive" 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' => [ '4 $/sample/blah',
# '3 $/sample/spaced out' ]
# } );
#
# 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;