#!/usr/bin/perl -w
#
# VSS to Perforce converter, phase II: improve metadata
#
# Copyright 1998 Perforce Software.  All rights reserved.
# Written by James Strickland, April 1998
#
# This script applies a heuristic to group multiple checkins as one change if
# a) they are within a user specified time interval of each other
# b) the change descriptions match
# c) the authors match
# d) no file appears twice
#
# Changes are searched for within the user specified time interval; they do
# not have to be adjacent.  e.g. if the time interval is 10 minutes and the
# following operations occurred between 9:00 and 9:10:
# 1 edit foo.c#2 9:00 by papa 'don't allow gear retraction if weight on wheels'
# 2 add blah.c#1 9:00 by papa 'don't allow gear retraction if weight on wheels'
# 3 edit bar.c#4 9:00 by mama 'overspeed sensor wasn't read properly before'
# 4 edit bap.c#7 9:02 by baby 'wrong attendant call button lit up'
# 5 edit goo.c#2 9:05 by papa 'rudder controls were backward'
# 6 edit baz.c#8 9:08 by mama 'overspeed sensor wasn't read properly before'
# 7 add foop.c#1 9:09 by papa 'don't allow gear retraction if weight on wheels'
# 8 edit foo.c#3 9:09 by papa 'fix typo in comment'
#
# then changes 1,2, and 7 will be amalgamated as one change (changes 3,4,6
# are by a different author, change 5 has a different change description,
# change 8 involves the same file as change 1).
#
# The next step will involve examining all changes within 10 minutes
# of change 3; this is the same list.  Now changes 3 and 6 will be
# amalgamated as one change.
#
# The next step will involve examining all changes within 10 minutes
# of change 4; that may involve examining, say,
# 9 add goop.c#1 9:11 by baby 'wrong attendant call button lit up'
# So now change 4 and 9 will be amalgamated.  etc..
#
# This process of looking ahead is typically called a "sliding window".
# Only the revisions within the search time interval are in memory at any
# given time.  Once objects are no longer referenced in Perl, they disappear.
# This should avoid problems with running out of memory.
#
# RHGC - fixed problem with more than one "unget" being called at a time.
#        Also some debug stuff inserted and left (no output produced so should be OK).

require 5.0;
use strict;
use integer;
use lib '.';
use convert;
use Change;

# For debug purposes.
sub trace_change
{
    my ($comment, $c) = @_;
    if (defined($c))
    {
#        print "Trace - Change: $comment:" . $c->timestamp . "\n";
        # " - " . $c->filelist . "\n";
    }
    else
    {
#        print "Trace - Change: empty\n";
    }
}

# For debug purposes.
sub trace
{
    my ($comment) = @_;
#    print "Trace: $comment\n";
}

# it is assumed that the changes have been sorted - initially they are written
# out as changes.ns ("not sorted") and changes is deleted, so this script
# should fail with a "can't open" message if the changes have not been sorted
open(CHANGES,    "<$convert::metadata_dir/changes")     or die "can't open: $!";
open(NEWCHANGES, ">$convert::metadata_dir/changes.new") or die "can't open: $!";


my (@nearby_changes,$current,$anotherchange,$num_changes);
my (@ungot_changes);

$num_changes=0;

while(!finished Change(\*CHANGES) || scalar(@nearby_changes) || scalar(@ungot_changes)) {

  # The next change to consider is the first one in @nearby_changes, if any,
  # otherwise the next one is read in
#  $current = (scalar(@nearby_changes)) ? shift(@nearby_changes)
#                                       : get Change(\*CHANGES);
  if (scalar(@nearby_changes))
  {
    $current = shift(@nearby_changes);
    trace_change("nearby ", $current);
  }
  elsif (scalar(@ungot_changes))
  {
    $current = shift @ungot_changes;
    trace_change("ungot  ", $current);
  }
  else
  {
    $current =  get Change(\*CHANGES);
    trace_change("new    ", $current);
  }


  # Extend @nearby_changes to include all changes with timestamps within
  # $time_interval of $current's timestamp
  while( !finished Change(\*CHANGES) || scalar(@ungot_changes)) {

    if (scalar(@ungot_changes))
    {
        $anotherchange = shift @ungot_changes;
        trace_change("n-ungot ", $anotherchange);
    }
    else
    {
        $anotherchange =  get Change(\*CHANGES);
        trace_change("n-new   ", $anotherchange);
    }


    if( ($anotherchange->timestamp) - ($current->timestamp) > $convert::time_interval ) {

      trace("ungetting");
      trace_change("current", $current);
      trace_change("another", $anotherchange);

      push @ungot_changes, $anotherchange;
      last;
    }
    else
    {
      trace("not ungetting");
    }

#    trace_change("push nearby", $anotherchange);
    push(@nearby_changes,$anotherchange);
  }

  my (%seen,$file,$duplicate_file,$i,$c);

  # mark all files in the current change as being seen
  # (note: typically there's only one file in the change)
  foreach $file ($current->filelist) {
    $seen{$file}=1;
  }

  # Look for matches in @nearby_changes

  for($i=0;$i<scalar(@nearby_changes);$i++) { # need index in order to do splice

    $c=$nearby_changes[$i];

    # we can only amalgamate changes if no filenames are duplicated within
    # the time period we're considering
    $duplicate_file=0;
    foreach $file ($c->filelist) {
      $duplicate_file=1 if( $seen{$file} );
      $seen{$file}=1;
    }

    if($c->change_description eq $current->change_description &&
       $c->author eq $current->author &&
       ! $duplicate_file ) {

      trace("adding to current");

      # add the changes to $current's changelist
      $current->changelist([ @{$current->changelist}, @{$c->changelist} ]);

      # remove the change which was just amalgamated
      splice(@nearby_changes,$i,1); $i--;
    }
  }
  $current->put(\*NEWCHANGES);
  $num_changes++;
}

close(CHANGES);
close(NEWCHANGES);

unlink("$convert::metadata_dir/changes") or die "can't delete changes: $!";
rename("$convert::metadata_dir/changes.new","$convert::metadata_dir/changes") or die "can't rename: $!";

print "Conversion will result in $num_changes changes.\n";