#! perl -w
#-----------------------------------------------------------------------------
# DISCLAIMER
# THE MATERIAL AND/OR SOFTWARE IS PROVIDED ‘AS IS’.  RATIONAL AND ITS THIRD PARTY 
# LICENSORS DISCLAIM ALL REPRESENTATIONS OR WARRANTIES EXPRESS OR IMPLIED INCLUDING, 
# WITHOUT LIMITATION, THE WARRANTY OF MERCHANTABILITY, NON-INFRINGEMENT, TITLE OR 
# FITNESS FOR A PARTICULAR PURPOSE OR ARISING OUT OF THE COURSE OF DEALING, USAGE OR 
# TRADE PRACTICE, CONTENT OF THE MATERIAL OR SOFTWARE.  RATIONAL MAKES NO WARRANTIES 
# OR REPRESENTATIONS REGARDING THE ACCURACY OR COMPLETENESS OF THE MATERIAL AND/OR 
# SOFTWARE PROVIDED OR THAT IT WILL MEET LICENSEE’S REQUIREMENTS OR THAT THE MATERIAL 
# AND/OR SOFTWARE WILL BE ERROR FREE.  IN NO EVENT SHALL RATIONAL OR ITS LICENSORS BE 
# LIABLE TO LICENSEE OR A THIRD PARTY FOR ANY INDIRECT, DIRECT, NEGLIGENCE, SPECIAL, 
# OR CONSEQUENTIAL DAMAGES INCLUDING LOST PROFITS, LOST DATA AND THE LIKE ARISING OUT 
# OF OR IN CONNECTION WITH THIS RECEIPT OF MATERIAL AND/OR SOFTWARE EVEN IF RATIONAL 
# HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.  
#-----------------------------------------------------------------------------
#
my ($infile, $rquid_id);
my (@inLines, @duplicate, %objects);
my $cmd = "d";
$version = "24-Apr-2002";

sub printHelp
{
    print <<EOT;

RTQUID_UTIL.PL will do ONE of the following:
 1. Display all quid ids in a file
 2. List all duplicate quid ids in a file
 3. Cleanup all duplicate quid ids in a file
 4. Replace all occurrences of a particular quid id with new
   unique ids
Note: the original model file is not modified. Instead a new
file with extension .rqu is created in the current directory.

Syntax: rtperl rtquid_util.pl [-c | -l | -r quid_id] modelfile
(Only one option at a time is accepted.)

Sample usage:
 rtperl rtquid_util.pl                  # displays this help text
 rtperl rtquid_util.pl modelfile        # show all quid ids
 rtperl rtquid_util.pl -l modelfile     # List all duplicate quids
 rtperl rtquid_util.pl -c modelfile     # Cleanup all duplicate quids
 rtperl rtquid_util.pl -r quidid modelfile  # Replace only requested quid
   
Current version: $version

EOT
#
	exit 0;
}
#
#-----------------------------------------------------------------------------
#
sub readArgs
{
# rtquid_util.pl [ -c | -r quid_id | -l ] mymodel
    unless ($_ = shift @ARGV ) { &printHelp; }
	if( m[^-c$]  ) { 
		$cmd = "c"; $_ = shift @ARGV;
	} elsif( m[^-r$]  ) { 
		$cmd = "r"; $rquid_id = shift @ARGV; $_ = shift @ARGV;
	} elsif( m[^-l$]  ) { 
		$cmd = "l"; $_ = shift @ARGV;
	}
	$infile = $_;
}
#
#-----------------------------------------------------------------------------
#
sub removeDuplicates
{
	my ($new_id, $obj, $tmp, $line_no);
	$new_id = sprintf("%0X", time);
	$new_id = $new_id . "0000";
	
	for ($i=0; $i < scalar(@duplicate); $i++) {
		$line_no = 0;
		foreach $line (@inLines) {
			$line_no += 1;
			if ($line =~ /\(object\s(.*)$/ ) {
				$obj = $1;
				next;
			}
			if ($line =~ /\s+quid\s+\"([0-9A-F]+)\"/ ) {
				if ($duplicate[$i][1] eq $obj) {
					if ($1 eq $duplicate[$i][0]) {
						$line =~ s/$1/$new_id/;
						$tmp = hex(substr($new_id, 8)) + 1;
						$new_id = sprintf "%s%04X", substr($new_id, 0, 8), $tmp;
						print "$new_id is the new quid for $obj \(line $line_no\)\n";
					}
				}
			}
		}
	}
	open(OFILE, ">$infile.rqu") or die "could not open $infile.rqu $!\n";
	while (@inLines) {
		print OFILE shift @inLines;
	}
	close (OFILE);
}
#
#-----------------------------------------------------------------------------
#
sub replaceQuid
{
	my ($new_id, $obj, $tmp, $line_no);
	$new_id = sprintf("%0X", time);
	$new_id = $new_id . "0000";	
	$line_no = 0;
	
	foreach $line (@inLines) {
		$line_no += 1;
		if ($line =~ /\(object\s(.*)$/ ) {
			$obj = $1;
			next;
		}
		if ($line =~ /\s+quid\s+\"([0-9A-F]+)\"/ ) {
			if ($1 eq $rquid_id) {
				$line =~ s/$1/$new_id/;
				$tmp = hex(substr($new_id, 8)) + 1;
				$new_id = sprintf "%s%04X", substr($new_id, 0, 8), $tmp;
				print "$new_id is the new quid for $obj \(line $line_no\)\n";
			}
		}
	}

	open(OFILE, ">$infile.rqu") or die "could not open $infile.rqu $!\n";
	while (@inLines) {
		print OFILE shift @inLines;
	}
	close (OFILE);
}
#
#-----------------------------------------------------------------------------
#
sub main
{
	my $dupl_ind = 0;
	my $line_no = 0;
	&readArgs;
	open (INFILE, "$infile") or die ("could not open $infile $!\n");
    @inLines = <INFILE>;
    close( INFILE );
	
	# Add objects that are not duplicates to %objects; report duplicates
	foreach $line (@inLines) {
		$line_no += 1;
		if ($line =~ /\(object\s(.*)$/ ) {
			$obj = $1;
			next;
		}
		if ($line =~ /\s+quid\s+\"([0-9A-F]+)\"/ ) {
			if ($cmd eq "d") { print "$1 $obj \(line $line_no\)\n"; }
			if (exists($objects{$1})) {
				$duplicate[$dupl_ind++] = ["$1", "$obj"];
				if ($cmd eq "l") {print "$1 $obj is a duplicate quid \(line $line_no\)\n"; }
			} else {
				$objects{$1} = $obj;
			}
		}
	}

	# We are done unless we need to write to the output file ...
	if ($cmd eq "c") { &removeDuplicates; }  # Replace the duplicate quid ids with new values ...
	if ($cmd eq "r") { &replaceQuid; }       # Or, replace the one quid requested by user
}

&main;
#