#!/usr/bin/perl -w

# TODO:
#      Add comments
#      File input/output 
#      Improve parser so that it can accept any valid input, not only sanitized input

# Usage:
# cat compiledTypes.txt | SipCodecTestGenerator.pl

use strict "vars";
use Class::Struct;

#--------------------------------------------------------------------------
my $testcaseTemplate = "\ttestcase %s() runs on SipSimu {\n\n"
    . "\t\t// Variables\n"
    . "\t\ttimer t_ac := 3.0;\n\n"
    . "\t\t// Test Body\n"
    . "\t\tsipPort.send(%s);\n"
    . "\t\tt_ac.start;\n"
    . "\t\talt {\n"
    . "\t\t\t[] sipPort.receive(%s) {\n"
    . "\t\t\t\tsetverdict(pass);\n"
    . "\t\t\t}\n"
    . "\t\t\t[] t_ac.timeout {\n"
    . "\t\t\t\tsetverdict(fail);\n"
    . "\t\t\t}\n"
    . "\t\t}\n"
    . "\t}\n\n";

my $templateModule = "SipCodecTest_LoopbackTemplates";
my $testcaseModule = "SipCodecTest_LoopbackTestcases";
my $controlModule = "SipCodecTest_LoopbackTestControl";
my $systemModule = "TestSystem";
my @typeModules = ("LibSip_SIPTypesAndValues", "LibSip_SDPTypes", "LibSip_XMLTypes");
my $debug;# = 1;

#--------------------------------------------------------------------------

my %types;
my @messages;
my %defaultValues;
my %templates;


struct(Field, {type => '$', name => '$', optional => '$', constraints => '@'});
struct(Type, {baseType => '$', type => '$', field => '@'});
struct(Template, {text => '$', ref => '$', before => '$', after => '$'});

#--------------------------------------------------------------------------

sub initializeDefaultValues() {
    %defaultValues = (
		      'charstring'          		=> ['"a"', '"abcde"', '"abcdefghij"'],
		      'integer'             		=> [1, 2, 3],
		      'boolean'             		=> ["true", "false"],
		      
		      'Request payload'						=> ["omit"],
		      'REGISTER_Request payload'	=> ["omit"],
        	'INVITE_Request payload'		=> ["omit"],
        	'OPTIONS_Request payload'		=> ["omit"],
        	'BYE_Request payload'				=> ["omit"],
        	'CANCEL_Request payload'		=> ["omit"],
        	'ACK_Request payload'				=> ["omit"],
        	'PRACK_Request payload'			=> ["omit"],
        	'NOTIFY_Request payload'		=> ["omit"],
        	'SUBSCRIBE_Request payload'	=> ["omit"],
        	'PUBLISH_Request payload'		=> ["omit"],
        	'UPDATE_Request payload'		=> ["omit"],
        	'REFER_Request payload'			=> ["omit"],
        	'MESSAGE_Request payload'		=> ["omit"],
        	'INFO_Request payload'			=> ["omit"],
        	'Response payload'					=> ["omit"], 
		      
		      'SipUrl scheme'       		=> ['"sip"'],
		      'StatusLine sipVersion'		=> ['"SIP/2.0"'],	
		      'RequestLine sipVersion'	=> ['"SIP/2.0"'],
		      'ContactBody wildcard'		=> ['"*"'],
		      'ContentType mediaType'		=> ['"application/sdp"'],
		      'DeltaSec'								=> ['"1"', '"123456"', '"123456789"'],
		      'PMediaAuthValue'					=> ['"DEAD"', '"BABE"', '"DEAF"', '"1EE7"'],	
		      
		      'SDP_Message protocol_version' 	=> [0],
		      'SDP_Message uri' 							=> ['"test_uri@etsi.org"'],
		      'SDP_contact addr_or_phone'			=> ['"test_email@etsi.org"', '"+33 4 - 9294 4200"'],
		      'SDP_contact disp_name'					=> ['"John Smith"', '"Jane Doe"'],
		      'SDP_typed_time unit'						=> ['"d"', '"h"', '"m"', '"s"'],
		      'SDP_time_field start_time'			=> ['"1243951581"'],
		      'SDP_time_field stop_time'			=> ['"1243951781"'],
		      'SDP_timezone adjustment_time'	=> ['"42"', '"1241781"'],
		      'SDP_Origin session_id'					=> ['"1"', '"2"', '"3"'],	
		      'SDP_Origin session_version'		=> ['"1"', '"2"', '"3"'],
		      'SDP_connection net_type'				=> ['"IN"'],
		      'SDP_connection addr_type'			=> ['"IP4"'],
		      'SDP_conn_addr addr'						=> ['"224.0.0.1"'],
		      'SDP_key method'								=> ['"prompt"', '"clear"', '"base64"', '"uri"'],
		      'SDP_attribute_curr statusType'	=> ['"e2e"', '"local"', '"remote"'],
		      'SDP_attribute_des statusType'	=> ['"e2e"', '"local"', '"remote"'],
		      'SDP_attribute_conf statusType'	=> ['"e2e"', '"local"', '"remote"'],
      		'SDP_attribute_curr direction'	=> ['"none"', '"send"', '"recv"', '"sendrecv"'],
      		'SDP_attribute_des direction'		=> ['"none"', '"send"', '"recv"', '"sendrecv"'],
      		'SDP_attribute_conf direction'	=> ['"none"', '"send"', '"recv"', '"sendrecv"'],
					'SDP_attribute_des strength' 		=> ['"mandatory"', '"optional"', '"none"', '"failure"', '"unknown"'].
		      
		      'UndefinedHeader headerName'		=> ['"az"', '"abcde"', '"abcdefghij"']
		      );
}


sub processTypeFile($) {
    my $typeFiles_ref = shift;
    my @typeFiles;
    my $file;
    my $line;
    my $BaseType;
    my $Type;
    
    @typeFiles = @$typeFiles_ref;  
    
    foreach $file (@typeFiles) {
	open(FILE, $file) or die "Unable to open file $file";
	while(defined($line=<FILE>)) {
	    if( # set of
		$line=~ m/^\s*type\s+set of\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/
		or $line=~ m/^\s*type\s+set of\s+(\S+)\s+(\S+)\s*$/ ){
		my @field;
		
		$BaseType = $1;
		$Type = $2;
		push (@field, new Field(type => $BaseType, optional => 1));
		$types{$Type} = new Type(baseType => "set of", type => $Type, field => \@field);
	    }
	    elsif( # record of
		   $line=~ m/^\s*type\s+record of\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/ 
		   or $line=~ m/^\s*type\s+record of\s+(\S+)\s+(\S+)\s*$/ ){
		my @field;
		
		$BaseType = $1;
		$Type = $2;
		push (@field, new Field(type => $BaseType, optional => 1));
		$types{$Type} = new Type(baseType => "record of", type => $Type, field => \@field);    
	    }
	    elsif( # port
		   $line=~ m/^\s*type\s+port\s+(\S+)\s+message\s*[\{|;]\s*$/ 
		   or $line=~ m/^\s*type\s+port\s+(\S+)\s+message\s*$/ ) {
		my $loop=1;
		while($loop==1 and defined($line=<FILE>)) {
		    if($line=~ m/^\s*(in|out|inout)\s*$/) {
			# do nothing
		    }
		    elsif($line=~ m/^\s*(\S*)\s*,\s*$/) {  
			push(@messages, $1);    
		    }
		    elsif($line=~ m/^\s*(\S*)\s*$/) {  
			push(@messages, $1);    
			$loop=0;
		    }
		    else {
			die("MISMATCH in port: $line");
		    }
		}
	    }
	    
	    elsif( # standard type
		   $line=~ m/^\s*type\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/
		   or $line=~ m/^\s*type\s+(\S+)\s+(\S+)\s*$/ ){    
		$BaseType = $1;
		$Type = $2;
		if($BaseType eq "record" or $BaseType eq "set" or $BaseType eq "union") {
		    my @field;
		    my $loop=1;
		    
		    while($loop==1 and defined($line=<FILE>)) {       
			my $optional;
			
			if($line=~ m/^\s*\{\s*$/) { 
			    # do nothing
			}
			elsif($line=~ m/^\s*\}\s*$/) { 
			    $loop=0;
			}
			elsif( # non-final field
			       $line=~ m/^\s*(\S*)\s+(\w*)\s*(\(.*\))?\s*(\s+optional)?\s*,\s*$/) { 
			    my @constraint;
			    if(defined $3) { 
				my $constraints = $3;
				@constraint = split(/,/, substr($constraints, 1, length($constraints) - 2));
			    }
			    if(defined $4) {
				$optional = 1;
			    }
			    else {
				$optional = 0;
			    }
			    push (@field, new Field(type => $1, name => $2, optional => $optional, constraints => \@constraint));
			}
			elsif( # final field
			       $line=~ m/^\s*(\S*)\s+(\w*)\s*(\(.*\))?\s*(\s+optional)?\s*$/) {  
			    my @constraint;
			    if(defined $3) {
				my $constraints = $3;
				@constraint = split(/,/, substr($constraints, 1, length($constraints) - 2));
			    }
			    if(defined $4) {
				$optional = 1;
			    }
			    else {
				$optional = 0;
			    }
			    push (@field, new Field(type => $1, name => $2, optional => $optional, constraints => \@constraint));
			    $loop=0;
			}
			else {
			    die("MISMATCH in record $Type: $line");
			}
		    }
		    $types{$Type} = new Type(baseType => $BaseType, type => $Type, field => \@field);
		}
		elsif($BaseType eq "charstring") {
		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
		}
		elsif($BaseType eq "integer") {
		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
		}
		elsif($BaseType eq "enumerated") {
		    my @field;
		    my $loop = 1;
		    
		    while($loop==1 and defined($line=<FILE>)) {                
			if($line=~ m/^\s*\{\s*$/) { 
			    # do nothing
			}
			elsif($line=~ m/^\s*\}\s*$/) { 
			    $loop=0;
			}
			elsif($line=~ m/^\s*(\S*)\s*,\s*$/) { 
			    push (@field, $1);
			}
			elsif($line=~ m/^\s*(\S*)\s*$/) {  
			    push (@field, $1);
			    $loop=0;
			}
			else {
			    die("MISMATCH in record $Type: $line");
			}
		    }
		    $types{$Type} = new Type(baseType => $BaseType, type => $Type, field => \@field);
		}
		elsif($BaseType eq "boolean") {
		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
		}
		else {
		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
		}
	    }    
	}
	close FILE;
    }
}

sub createTemplatesFromRecord($) {
    my $type = shift;
    
    print "createTemplatesFromRecord\n" if defined $debug;
    
    bless($type, 'Type');
    helper_createTemplatesFromRecord($type, "all");
    helper_createTemplatesFromRecord($type, "none");
    helper_createTemplatesFromRecord($type, "random");
}


sub helper_createTemplatesFromRecord($ $) {
    my $type = shift;
    my $optionalStrategy = shift;
    my $baseTemplateIndex;
    my @fields_;
    my $field;
    my $fieldIndex;

    print "helper_createTemplatesFromRecord\n" if defined $debug;
    
    bless($type, 'Type');
    
    if(defined $templates{$type->type}) {
	$baseTemplateIndex = scalar @{$templates{$type->type}};
    }
    else {
	$baseTemplateIndex = 0;
    }
    ${$templates{$type->type}}[$baseTemplateIndex] = new Template(text => "{\n");
    
    @fields_ = @{$type->field};
    for($fieldIndex=0; $fieldIndex < scalar @fields_;) { # incremented while inserting comma !
	my $fieldType;
	my $fieldTypeName;
	my $comma;

	$field = $fields_[$fieldIndex];
	$comma = (++$fieldIndex == scalar @fields_) ? "" : ",";
	
	bless($field, 'Field');
	$fieldTypeName = $field->type;
	
	if(
	   ($optionalStrategy eq "all")
	   or (($optionalStrategy eq "none" or $optionalStrategy eq "random") and $field->optional == 0)
	   or ($optionalStrategy eq "random" and $field->optional == 1 and round(rand()) == 1)) {

	    if((scalar @{$field->constraints} > 0)
	       or $fieldTypeName eq "charstring" 
	       or $fieldTypeName eq "integer" 
	       or $fieldTypeName eq "boolean") {
		# Terminal field
		# Derive all possible values
		
		my $vals_ref;
		my @vals = [];
		my $i;
		my $before;
		my $after;
		
		if(scalar @{$field->constraints} > 0) {
		    $vals_ref = $field->constraints;
		}
		else {
		    $vals_ref = $defaultValues{$type->type . ' ' . $field->name};
		    $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
		    die("Undefined default values for $fieldTypeName") unless defined $vals_ref;
		}
		@vals = @$vals_ref;
		
		$before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
		
		${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 
								     . "\t" . $field->name . ' := ' . $vals[0] . "$comma \n");

		$after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
		
		## Derive all values
		for($i=1; $i < scalar @vals; $i++) {        
		    push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := ' . $vals[$i] . "$comma \n",
								    ref => $baseTemplateIndex,
								    before => $before,
								    after => $after));
		}      
	    }
	    else { 
		# Templatable field      
		
		my $vals_ref;

		$fieldType = $types{$fieldTypeName};
		die("Undefined type $fieldTypeName") unless defined($fieldType);
		
		$vals_ref = $defaultValues{$type->type . ' ' . $field->name};
		$vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
		if(defined $vals_ref) {

		    my @vals = [];
		    my $i;
		    my $before;
		    my $after;
		    
		    @vals = @$vals_ref;
		    
		    # override with default values
		    $before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
		    
		    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 
									 . "\t" . $field->name . ' := ' . $vals[0] . "$comma \n");
		    
		    $after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
		    
		    ## Derive all values
		    for($i=1; $i < scalar @vals; $i++) {        
			push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := ' . $vals[$i] . "$comma \n",
									ref => $baseTemplateIndex,
									before => $before,
									after => $after));
		    } 
		}
		else {
		    if(defined $templates{$fieldTypeName}) {
			# Sub-template has already been defined and derived.
			# Use template 0.        
			${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 
									     . "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0$comma \n"); 
		    }
		    else {    
			# Sub-template not yet defined. 
			# Use all template versions.
			my $before;
			my $after;
			my $i;
			
			createTemplatesFromType($fieldType);
			die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
			
			$before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
		    
			${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 
									     . "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0$comma \n");  
		    
			$after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
			
			# Derive all template versions          
			for($i=1; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
			    push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n",
									    ref => $baseTemplateIndex,
									    before => $before,
									    after => $after));  
			}    
		    }
		}      
	    }
	}
	else {
	    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 
								 . "\t" . $field->name . " := omit$comma \n");  
	}
    }   
    
    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text . "};\n");
}

sub createTemplatesFromSet($) {
    my $type = shift;
    
    createTemplatesFromRecord($type);
}

sub createTemplatesFromRecordOf($) {
    my $type = shift;
    my $i;
    my @fields_;
    my $field;
    my $fieldTypeName;
    my $comma;

    print "createTemplatesFromRecordOf\n" if defined $debug;
    
    bless($type, 'Type');

    ${$templates{$type->type}}[0] = new Template(text => "{\n");

    @fields_ = @{$type->field};
    $field = $fields_[0];
    bless($field, 'Field');
    $fieldTypeName = $field->type;

    if(defined $templates{$fieldTypeName}) {
	${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 
					    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_0\n");  
	
    }
    else {
	if($fieldTypeName eq "charstring" 
	   or $fieldTypeName eq "integer" 
	   or $fieldTypeName eq "boolean") {
	    # Terminal field
	    # Derive all possible values
	    
	    my $vals_ref;
	    my @vals = [];
	    my $i;

	    $vals_ref = $defaultValues{$type->type . ' ' . $fieldTypeName};
	    $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
	    die("Undefined default values for $fieldTypeName") unless defined $vals_ref;

	    @vals = @$vals_ref;
	    
	    ## Derive all values
	    for($i=0; $i < scalar @vals; $i++) {        
		$comma = ($i+1 == scalar @vals) ? "" : ",";
		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 
						    . "\t" . $vals[$i] . "$comma \n");
	    }      
	}
	else {
	    # Templatable field      

	    createTemplatesFromType($types{$fieldTypeName});
	    die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
	    
	    # Derive all template versions          
	    for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
		$comma = ($i+1 == scalar @{$templates{$fieldTypeName}}) ? "" : ",";
		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 
						    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n");  
	    }
	}
    }
    
    ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text . "};\n");
}  

sub createTemplatesFromSetOf($) {
    my $type = shift;
    my $i;
    my @fields_;
    my $field;
    my $fieldTypeName;
    my $comma;
    
    print "createTemplatesFromSetOf\n" if defined $debug;
    
    bless($type, 'Type');

    ${$templates{$type->type}}[0] = new Template(text => "{\n");

    @fields_ = @{$type->field};
    $field = $fields_[0];
    bless($field, 'Field');
    $fieldTypeName = $field->type;

    if(defined $templates{$fieldTypeName}) {
	${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 
					    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_0\n");  
	
    }
    else {
	if($fieldTypeName eq "charstring" 
	   or $fieldTypeName eq "integer" 
	   or $fieldTypeName eq "boolean") {
	    # Terminal field
	    # Derive all possible values
	    
	    my $vals_ref;
	    my @vals = [];
	    my $i;
	    
	    $vals_ref = $defaultValues{$type->type . ' ' . $fieldTypeName};
	    $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
	    die("Undefined default values for $fieldTypeName") unless defined $vals_ref;

	    @vals = @$vals_ref;
	    
	    ## Derive all values
	    for($i=0; $i < scalar @vals; $i++) {        
		$comma = ($i+1 == scalar @vals) ? "" : ",";
		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 
						    . "\t" . $vals[$i] . "$comma \n");
	    }      
	}
	else {
	    # Templatable field      

	    createTemplatesFromType($types{$fieldTypeName});
	    die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
	    
	    # Derive all template versions          
	    for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
		$comma = ($i+1 == scalar @{$templates{$fieldTypeName}}) ? "" : ",";
		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 
						    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n");  
	    }
	}
    }
    
    ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text . "};\n");
}   

sub createTemplatesFromUnion($) {
    my $type = shift;
    my @fields_;
    my $field;

    print "createTemplatesFromUnion\n" if defined $debug;
    
    bless($type, 'Type');

    @fields_ = @{$type->field};
    foreach $field (@fields_) {
	my $fieldType;
	my $fieldTypeName;
	
	bless($field, 'Field');
	$fieldTypeName = $field->type;
	
	if((scalar @{$field->constraints} > 0)
	   or $fieldTypeName eq "charstring" 
	   or $fieldTypeName eq "integer" 
	   or $fieldTypeName eq "boolean") {
	    # Terminal field
	    # Derive all possible values
	    
	    my $vals_ref;
	    my @vals = [];
	    my $i;

	    if(scalar @{$field->constraints} > 0) {
		$vals_ref = $field->constraints;
	    }
	    else {
		$vals_ref = $defaultValues{$type->type . ' ' . $field->name};
		$vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
		die("Undefined default values for $fieldTypeName") unless defined $vals_ref;
	    }
	    @vals = @$vals_ref;
	    
	    ## Derive all values
	    for($i=0; $i < scalar @vals; $i++) {        
		push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := ' . $vals[$i] . "\n}\n"));
	    }      
	}
	else { 
	    # Templatable field      
	    
	    $fieldType = $types{$fieldTypeName};
	    die("Undefined type $fieldTypeName") unless defined($fieldType);
	    
	    if(defined $templates{$fieldTypeName}) {
		# Sub-template has already been defined and derived.
		# Use template 0.        
		push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0\n}\n")); 
	    }
	    else {    
		# Sub-template not yet defined. 
		# Use all template versions.
		my $i;
		
		createTemplatesFromType($fieldType);
		die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
		
		# Derive all template versions          
		for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
		    push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_" . $i . "\n}\n")); 
		}    
	    }      
	}
    }   
} 

sub createTemplatesFromEnum($) {
    my $type = shift;
    my $vals_ref;
    my @vals = [];
    my $i;    
    
    print "createTemplatesFromEnum\n" if defined $debug;
    
    bless($type, 'Type');

    $vals_ref = $type->field;
    $vals_ref = $defaultValues{$type->type} unless defined $vals_ref;
    die("Undefined default values for " . $type->type) unless defined $vals_ref;

    @vals = @$vals_ref;
    
    ## Derive all values
    for($i=0; $i < scalar @vals; $i++) {        
	push(@{$templates{$type->type}}, new Template(  text => $vals[$i] . ";\n"));
    }      
} 

sub createTemplatesFromAlias($) {
    my $type = shift;
    my $baseTypeName;
    my $baseType;
    
    print "createTemplatesFromAlias\n" if defined $debug;
    
    bless($type, 'Type');

    $baseTypeName = $type->baseType;
    
    if($baseTypeName eq "charstring" 
       or $baseTypeName eq "integer" 
       or $baseTypeName eq "boolean") {
	# Terminal field
	# Derive all possible values
	
	my $vals_ref;
	my @vals = [];
	my $i;

	$vals_ref = $defaultValues{$type->type};
	$vals_ref = $defaultValues{$baseTypeName} unless defined $vals_ref;
	die("Undefined default values for $baseTypeName") unless defined $vals_ref;
	@vals = @$vals_ref;
	
	push(@{$templates{$type->type}}, new Template( text => $vals[0] . ";\n"));
	
	## Derive all values
	for($i=1; $i < scalar @vals; $i++) {        
	    push(@{$templates{$type->type}}, new Template(  text => $vals[$i] . ";\n"));
	} 
    }     
    else {  
	$baseType = $types{$baseTypeName};    
	die("Undefined type $baseTypeName") unless defined($baseType);
	
	if(defined $templates{$baseTypeName}) {
	    # Sub-template has already been defined and derived.
	    # Use template 0.        
	    push(@{$templates{$type->type}}, new Template( text => 'm_' . lcfirst($baseTypeName) . "_0;\n")); 
	}
	else {    
	    # Sub-template not yet defined. 
	    # Use all template versions.
	    my $i;
	    
	    createTemplatesFromType($baseType);
	    die "Undefined templates for $baseTypeName" unless defined $templates{$baseTypeName};
	    
	    push(@{$templates{$type->type}}, new Template( text => 'm_' . lcfirst($baseTypeName) . "_0;\n")); 
	    
	    # Derive all template versions          
	    for($i=1; $i < scalar @{$templates{$baseTypeName}}; $i++) {
		push(@{$templates{$type->type}}, new Template(  text => 'm_' . lcfirst($baseTypeName) . "_" .$i . ";\n"));  
	    }  
	}  
    }      
} 

sub createTemplatesFromType($) {
    my $type = shift;
    
    print "createTemplatesFromType\n" if defined $debug;
    
    bless($type, 'Type');
    
    if($type->baseType eq "record") {
	createTemplatesFromRecord($type);
    }
    elsif($type->baseType eq "set") {
	createTemplatesFromSet($type);
    }
    elsif($type->baseType eq "record of") {
	createTemplatesFromRecordOf($type);
    }
    elsif($type->baseType eq "set of") {
	createTemplatesFromSetOf($type);
    }
    elsif($type->baseType eq "union") {
	createTemplatesFromUnion($type);
    } 
    elsif($type->baseType eq "enumerated") {
	createTemplatesFromEnum($type);
    } 
    else {
	#Alias
	createTemplatesFromAlias($type);
    }
}

sub createTemplates() {
    my $message;
    
    print "createTemplates\n" if defined $debug;
    
    foreach $message (@messages) {
	my $type;
	
	$type = $types{$message};
	die("Undefined message $message") unless defined($type);
	
	createTemplatesFromType($type);
    }
}

sub printTemplates($ $) {
    my $module = shift;
    my $imported = shift;
    my @imports;
    my $key;
    my $i;
    
    @imports = @$imported;

    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";
    print FILE "module $module {\n\n";
    foreach $imported (@imports) {
	print FILE "\timport from $imported all;\n";
    }
    print FILE "\n";
    foreach $key (keys %templates) {
	my @templates_array = @{$templates{$key}};
	
	for($i=0; $i < scalar @templates_array; $i++) {
	    my $parentRef;

	    $parentRef = $templates_array[$i]->ref;
	    $parentRef = 0 unless defined $parentRef;
	    print FILE "template $key m_" . lcfirst(${key}) . "_$i := ";
	    print FILE substr($templates_array[$parentRef]->text, 0, $templates_array[$i]->before) if defined $templates_array[$i]->before;
	    print FILE $templates_array[$i]->text;
	    print FILE substr($templates_array[$parentRef]->text, $templates_array[$i]->after) if defined $templates_array[$i]->after;
	    print FILE "\n";
	}
    }
    print FILE "} // end module\n";
    close FILE;
}

sub printTestcases($ $) {
    my $module = shift;
    my $imported = shift;
    my @imports;
    my $message;
    my $i;
    
    @imports = @$imported;

    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";
    print FILE "module $module {\n\n";
    foreach $imported (@imports) {
	print FILE "import from $imported all;\n";
    }
    print FILE "\n";
    foreach $message (@messages) {
	my @templates_array = @{$templates{$message}};
	
	for($i=0; $i < scalar @templates_array; $i++) {
	    my $testcaseName = "TC_LOOPBACK_" . uc($message) . "_" . $i;
	    my $templateName = "m_" . lcfirst($message) . "_" . $i;

	    printf FILE $testcaseTemplate, $testcaseName, $templateName, $templateName;
	}
    }
    print FILE "} // end module\n";
    close FILE;
}

sub printControl($ $) {
    my $module = shift;
    my $imported = shift;
    my @imports;
    my $message;
    my $i;
    
    @imports = @$imported;

    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";
    print FILE "module $module {\n\n";
    foreach $imported (@imports) {
	print FILE "import from $imported all;\n";
    }
    print FILE "\n";
    print FILE "control {\n";
    foreach $message (@messages) {
	my @templates_array = @{$templates{$message}};
	
	for($i=0; $i < scalar @templates_array; $i++) {
	    my $testcaseName = "TC_LOOPBACK_" . uc($message) . "_" . $i;

	    print FILE "\texecute(${testcaseName}());\n";
	}
    }
    print FILE "}\n";
    print FILE "} // end module\n";
    close FILE;
}

sub round($) {
    my $number = shift;
    return int($number + .5 * ($number <=> 0));
}

# MAIN
my @imports;

initializeDefaultValues(); 

@imports = ("compiledTypes.txt");
processTypeFile(\@imports); #TODO ideally would be: \@typeModules

# Create templates !
createTemplates();

# save template file
printTemplates($templateModule, \@typeModules);

# save testcase file
@imports = ($systemModule, $templateModule);
printTestcases($testcaseModule, \@imports);

# save control file
@imports = ($testcaseModule);
printControl($controlModule, \@imports);