Change.pm #4

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

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


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";
}


1;