#!/usr/local/bin/perl
#
#
#(C) 1998, 1999 X/Open Co Ltd.  (C) 1999, 2000 WAP Forum Ltd.  All rights reserved
#
# mod_templates -- Modifies a perl framework template to that used for the
# java framework
#
# mod_templates path_root path_to_check
# path_root = full path to the root of the test suite
#
# The script will traverse the test source tree examining tests. For each test
# (template or deck etc...) it will...
#
# 1) Removes all HEAD text from the TYPE field
# 2) Adds '<card newcontext="true" id="main">' to the top of the METHOD field
#    for the tests that DO NOT have HEAD in the TYPE field and don't already
#    have this at the top
# 3) Adds '</card>' to the bottom of the method for ALL tests that don't already
#    have it
# 4) Replaces all instances of '$TestConfig::SITE_URL_HOST' with the tag
#    <site_url_host>
# 5) Replaces all instances of '$TestConfig::SITE_URL_ROOT' with the tag
#    <site_url_root>
# 6) Replaces all instances of 'tests/wap/' to 'scripts/'
# 7) Remove all instances of 'index.eml' from the templates
# 8) Change all instances of 'deckn.eml' with '<deckn>' within the template
# 9) Change all instances of 'scriptn.eml' with '<scriptn>' within the template
# 10) Change all files named 'deckn.eml' to 'deckn'
# 11) Get rid of the 'prompt' field in the template 
# 12) and add the wml prompt code to the end of the method insted.  Only for
#     tests where there is actually a prompt
# 13) if the Result field contains 'yesno' then change to 'submit:yes'
# 14) Remove the 'files' field
# 15) If the test is a manual test and the type field does not contain
#     'MANUAL' add it.
# 16) If the templates have locale then just leave the Stringn: field in
# 17) Adds a Testtype: APPLICATION line to the file, only if one is NOT there already.
# 18) Handles Uaprofmethod and Pushmethods and Pushreturns.
# 19) Handles Cachemethod and Cacheheader...

# Test for number of input parameters
if (!@ARGV[0] or @ARGV[2]) {
    print "Syntax: mod_templates path_root path_to_check\n";
    print "\t path_root = full path to the root of the test suite\n";
    print "\t path_to_check = path to start the checking from.  Relative to path_root\n";
    die "\t example: mod_templates \"/togdev/projects/wap/wapxxx\" \"tests/wap/wml\"\n";
}

# Set parameters
$tr = @ARGV[0];
$start_path = @ARGV[1];

# Get files to check
traverse($start_path);
# Change the templates

# Get the file
foreach $localefile (@localefiles) {
    open (CURRFILE, "$tr/$localefile") || die("Can't open $localefile\n");

#Initialise vars
    %hash = ();
    %orig_hash = ();

# read each line in one at a time
    while ($line = <CURRFILE>) {

# Get the parts in a hash table
    if ($line =~ /^\w*[\.]*\w*\:/) {
	($fieldname, $line) = split /:/, $line, 2 ;
	$fieldname =~ s/\s//g;

# Init vars
##	$orig_fieldname = "orig_" . lc($fieldname);
	$fieldname = lc($fieldname);
    }

# If this is a localisation field ignore it
    if ($fieldname =~ /string\d*\./i) {
	# Do nothing.  It is a localisation string
	next;
    } else {

# create a hash for reference
##    $hash{$orig_fieldname} = $hash{$orig_fieldname} . $line;
	$orig_hash{$fieldname} = $orig_hash{$fieldname} . $line;
    }

# Add in a new field for Testtype.
    if ($hash{"testtype"} eq "\s")
    {
    
       $hash{"testtype"} = "APPLICATION";
       $orig_hash{"testtype"}  = "APPLICATION";

    }

# Do the non specific field changes
    
# Do (4)
    if ($line =~ /$TestConfig::SITE_URL_HOST/) {
	$line =~ s/\$TestConfig::SITE_URL_HOST/\<site_url_host\>/g;
    }

# Do (5)
    if ($line =~ /$TestConfig::SITE_URL_ROOT/) {
	$line =~ s/\$TestConfig::SITE_URL_ROOT/\<site_url_root\>/g;
    }
    
# Do (6)
    if ($line =~ /tests\/wap\//) {
	$line =~ s/tests\/wap\//scripts\//g;
    }

# Do (7)
    if ($line =~ /index\.eml/) {
	$line =~ s/index\.eml//g;
    }

# Do (8)
    if ($line =~ /deck\d+\.eml/) {
	$_ = $line;
	@match1 = m/deck\d+\.eml/g;
	$match2 = $match1[0];
	$match2 =~ s/\.eml//;
	$line =~ s/$match1[0]/<$match2>/;
    }

# Do (9)
    if ($line =~ /script\d+\.eml/) {
	$_ = $line;
	@match1 = m/script\d+\.eml/g;
	$match2 = $match1[0];
	$match2 =~ s/\.eml//;
	$line =~ s/$match1[0]/<$match2>/;
    }

    $hash{$fieldname} = $hash{$fieldname} . $line;

}

# Now we have the hashes, do the field specific changes the changes

# Do (1)
    $newfieldvalue = $hash{type};
    $newfieldvalue =~ s/head//;
    
    $hash{type} = $newfieldvalue;


# Do (2)
    $newfieldvalue = $hash{method};
    $typefield = $orig_hash{type};

    if (!($typefield =~ /head/i)) {
	if (!($newfieldvalue =~ /^\s*<card/i)) {

	    $newfieldvalue = "<card newcontext=\"true\" id=\"main\">" . $newfieldvalue;

	}
    }
    
    $hash{method} = $newfieldvalue;


# Do (3) & (12)
    $newfieldvalue = $hash{method};
    $typefield = $orig_hash{type};
    $promptfield = $orig_hash{prompt};
    $promptfield =~ s/^\s//;
    chomp $promptfield;

    if (($typefield =~ /auto/i) | ($promptfield eq "")) {
	if (!($newfieldvalue =~ /card>/i)) {
	    $newfieldvalue = $newfieldvalue . "</card>\n";
	}
    } else {
	if (!($newfieldvalue =~ /card>/i)) {
	    $newfieldvalue = $newfieldvalue . "\<p mode=\"wrap\"\>$promptfield\n\<br \/>\n\<yesno\>\n\</p\>\n\</card\>\n";
	}
    }

    $hash{method} = $newfieldvalue;


# Do (13)
    $newfieldvalue = $hash{results};

    if ($newfieldvalue =~ /yesno/i) {
	$newfieldvalue =~ s/yesno/submit\:yes/;
    }

    $hash{results} = $newfieldvalue;


# Do (15)
    $newfieldvalue = $hash{type};

    if (!($newfieldvalue =~ /auto/i)) {
	$newfieldvalue = "MANUAL\n";
    }

    $hash{type} = $newfieldvalue;


# Do (10)
    $localefile_len = length($localefile);
    $localefile_ext = substr ($localefile, ($localefile - 4));
	if ($localefile_ext =~ /\.eml/) {
	    $localefile =~ s/\.eml//;
	}

# Now re-write the file
    unlink("$tr/$localefile");
    open (NEWFILE,">$tr/$localefile");
    
# print the fields out in order
    print_to_file(copyright);
    print_to_file(revision);
    print_to_file(date);
    print_to_file(id);
    print_to_file(device);
    print_to_file(class);
    print_to_file(scope);
    print_to_file(type);

    if (!$hash{"testtype"})
    {

       $hash{"testtype"} = "APPLICATION";

    }

    print_to_file(testtype);
    print_to_file(source);
    print_to_file(text);
    print_to_file(notes);
    print_to_file(specnote);
    print_to_file(results);

# only print the default locale string
    foreach $key (sort keys %hash) {
	if ($key =~ /string\d+/i) {
	    print_to_file($key);
	} 
    }

    print_to_file(method);

# print out the cards
    foreach $key (sort keys %hash) {
	if ($key =~ /card\d+/) {
	    print_to_file($key);
	}
    }

# print out the decks
    foreach $key (sort keys %hash) {
	if ($key =~ /deck\d+/) {
	    print_to_file($key);
	}
    }

# print out the cache methods...
    foreach $key (sort keys %hash) {
      if ($key =~ /cachemethod\d+/) {

	 print_to_file ($key);

      }

    }

# print out the cache headers...
    foreach $key (sort keys %hash) {

      if ($key =~ /cacheheader\d+/) {

	 print_to_file ($key);

      }

    }

# print out the uaprofmethods
    foreach $key (sort keys %hash) {

        if ($key =~ /uaprofmethod\d+/) {

	    print_to_file($key);

	}

    }

# print out the pushmethods
    foreach $key (sort keys %hash) {

        if ($key =~ /pushmethod\d+/) {

	    print_to_file($key);

	}

    }

# print out the pushreturns
    foreach $key (sort keys %hash) {

        if ($key =~ /pushreturn\d+/) {

	    print_to_file($key);

	}

    }

# print out the scripts
    foreach $key (sort keys %hash) {
	if ($key =~ /script\d+/) {
	    print_to_file($key);
	}
    }

    close (NEWFILE);
    print "Checked: $tr/$localefile\n"; 
}

sub print_to_file {
    $fieldtoprint = shift;
    $valuetoprint = $hash{$fieldtoprint};
    $valuetoprint =~ s/^\s//;
    chomp $valuetoprint;

    # Convert the fieldtoprint to all lowercase - GB.
    $fieldtoprint = lc $fieldtoprint;
    $fieldtoprint = ucfirst $fieldtoprint;

    if ($valuetoprint ne "") {
	print NEWFILE $fieldtoprint . ": $valuetoprint\n";
    } else {
	print NEWFILE $fieldtoprint . ":\n";
    }

}

sub traverse {
    my ($tdir) = @_;

    my $srcdir = "$tr/$tdir";

    my ($files, $dirs) = assertions_in_directory($srcdir);

    for $f (@$files) {
	push (@localefiles, "$tdir/$f");
    }

    for $d (@$dirs) {
	my $t1;
	$t1 = length($tdir) ? "$tdir/$d" : $d;
	traverse($t1, "$destdir/$d");
    }

#    return @localefiles;
}

sub assertions_in_directory {
    my $dir = shift;
    my $files = [];
    my $dirs = [];
    my $f;
    local(*D);

    opendir(D, $dir);
    while (defined($f = readdir(D))) {
        if (-d "$dir/$f") {
            next if ($f eq '.' || $f eq '..' || $f eq 'CVS');
            push(@$dirs, $f);
        } elsif (-f "$dir/$f" and (($f =~ /^\d+$/) or ($f =~/\.eml$/))) {
            push(@$files, $f);
        }
    }
    closedir(D);
    ($files, $dirs);
}
