#!/usr/bin/perl -w
use strict;

################################################################################
#                                                                              #
#  Copyright (C) 2002 Wim Vanderbauwhede. All rights reserved.                 #
#  This program is free software; you can redistribute it and/or modify it     #
#  under the same terms as Perl itself.                                        #
#                                                                              #
################################################################################

#This version 23/12/2002. Added some comments on 10/02/2003.
#Bugs, bugs 11/02/2003
#Added $number_of_levels, removed obsolete stuff, 19/02/2003

#-----------------------------------------------------------------------
## All codes inside the brackets ( ) are used. 
## Codes must be space-separated; the number of spaces is not relevant.
my @codes= qw(CCH HAE BS BT MB IMM HP NCC CCY PM ANS);

my $number_of_levels=3;
## Name of the input file. This is case-sensitive.
my $inputfile='User_Guide_Part3.mif';

## Output files are named yourInputFilename_CODE.mif
my $outputfile=$inputfile;
$outputfile=~s/\.mif/_/;

## A logfile is created at every run.
## Might be useful for debugging
my $logfile='split_MIF_log.txt';
#-----------------------------------------------------------------------
#$inputfile=(@ARGV)?$ARGV[0]:$inputfile;

if(-e "$logfile"){unlink "$logfile"};
open TMP, ">$logfile";

foreach my $code (@codes) {

my %blocks=();


my @current=();
$current[0]='';
my $current=''; #join(' - ',@codes);
my $para=0;
my $paracont='';
my $level=0;
$blocks{$level}{$code}=1;
foreach my $cc (@codes){
  for my $level (1..$number_of_levels){
$blocks{$level}{$code}=0;
}
}
my $ok=1;
my $tag='';
print TMP "\n\nCODE: $code\n\n";

unlink "$outputfile$code.mif";
open(OUT,">$outputfile$code.mif");

open(MIF,"<$inputfile");
while(<MIF>) {
  ## Here begins the real parsing ##
#------------------------------------------------------------------------------    
  if(/\<Para\s*$/) { # start of Para
    $para=1;
  }

  if($para==1) { # add para lines to string
/Unique/ && do{$tag=$_;chomp $tag;};
    $paracont.=$_;
  } else { # just print
    print OUT $_;
  } # assumes no line outside para except preamble/postamble

  if(/\[\[(\w+(\ -\ \w+)*)\]\]/) { # found a start tag
    my $blocks=$1;
    $current=$blocks;
    $level++;
    $current[$level]=$current;
    print TMP "BEGIN $current[$level] : $level\n";
    my @blocks=split(/\ -\ /,$blocks);
    foreach my $block (@blocks){
      $blocks{$level}{$block}=1;
    }
  } elsif (/\[\[\$(\w+(\ -\ \w+)*)\]\]/) { # found an end tag
    my $blocks=$1;
    print TMP "END $current[$level] : $level\n";
    my @blocks=split(/\ -\ /,$blocks);
    foreach my $block (@blocks){
      $blocks{$block}=0;
      $blocks{$level}{$block}=0;
    }
    $level--;

    if($level==0){$current='';
		  print TMP "Not inside a block : $level\n";
		} else {
		  $current=$current[$level];
		}
  }
#------------------------------------------------------------------------------  
  if (/\>\ \#\ end\ of\ Para\s*$/) { # reached end of para
    $para=0;

    if($paracont=~/ATbl/s) {
print TMP "BEGINCHECK\ncurrent:$current blocks($level)($code):$blocks{$level}{$code}\n$paracont\nENDCHECK\n";
}

    #($paracont!~/\[\[\$*\w/m): Para has no [[ tag or [[$ tag
    #($current=~/$code/): the list of tags contains the current code
    #($blocks{$level}{$code}==1) : this Para of this level belongs to $code
    #!/\[\[\$*\w/ : Current Para line has no [[$ tag or [[ tag

    if(
       ($paracont!~/\[\[\$*\w/m) && 
       ( 
	   ($blocks{$level}{$code}==1)
       )
      ) {
      print OUT $paracont;

    #Now, if contains a start tag, and current matches code, and the paragraph contains anything else than the tag, we should just remove the tag and keep all the rest!
    
    #($paracont=~/\[\[\w/m): Para has a [[ tag
    #($current=~/$code/): the list of tags contains the current code
    #($blocks{$level}{$code}==1) : this Para belongs to $code
    #!/\[\[\$*\w/ : Current Para line has no [[$ tag.

    } elsif (
       ($paracont=~/\[\[\w/m) && 
       ( 
	   ($blocks{$level}{$code}==1)
       )
      ) {
      my $paraconttmp=$paracont;
      $paraconttmp=~s/.*\w\]\]\'\>\s*//ms;
      #Better? TEST THIS!!
      #$paraconttmp=~s/\s*\<String\ \`\[\[\w+.*\]\]\'\>\s*//ms;
      
      $paraconttmp=~s/\s*\>\ \#\ end\ of\ ParaLine\n\s+\>\ \#\ end\ of\ Para\s*//;
      print TMP "#!#BEGIN $current -> $code#!#";
      print TMP $paracont;
      print TMP "#!# $current => $code END#!#\n";
      if($paraconttmp) { 
      print TMP "PARACONTTMP: $paraconttmp\nENDPARACONTTMP\n";
      print TMP "PARACONT: $paracont\nENDPARACONT\n";
	$paracont=~s/\s*\<String\ \`\[\[\w+.*$//m;
      print TMP "PARACONTNOTAG: $paracont\nENDPARACONTNOTAG\n";
	print OUT $paracont;
      }
    } else {
print TMP "No [[:$tag: $current: ", ($paracont=~/\[\[\w/m),'&&(', ($current eq ''), '||(',($current=~/\b$code\b/), '&&', ($blocks{$level}{$code}==1),'))=',(
       ($paracont=~/\[\[\w/m) && 
       ( ($current eq '') ||
	 ( ($current=~/\b$code\b/) && 
	   ($blocks{$level}{$code}==1) )
       )
      ),"\n";
}

    $paracont='';
  } # End of Para processing
} # while MIF

close MIF;
close OUT;
} # foreach $code

close TMP;