Change.pm #5

# 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;