#!perl
#

package buildInput;

use strict;

use Exporter ();
use vars qw(@ISA @EXPORT);
BEGIN {
  @ISA = qw(Exporter);
  @EXPORT = qw(&getInput);
}

1;

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

sub getInput {

  use DBI;
  use strict;
    
# Read the database user name and password from a file
# The file must be two lines with user name and password
# on separate lines.  There must be no blank lines at the
# end of the file.

  my $dbname="b0dau30.fnal.gov"; 
  my $temp;
  my $user;
  my $password;
  open (USERNAME,"test.user") || die "can't open file: $!";
  while (defined ($temp = <USERNAME>)) 
  {
     chomp $temp; 
     $user = $temp;
     $password=<USERNAME>;
     chomp $password;
  };
  close (USERNAME) || die "couldn't close file: $!";
 
#note how connection specifies Oracle here, msql, mysql or any
#other DBI driver will work exactly the same
#
  my ($dbh) = DBI->connect($dbname,$user,$password,'Oracle') ||
    die "Error connecting $DBI::errstr\n";
        
  my $template = shift;
  my $myfile=$template;
  my $line;
  
#
#  now get the unique instances (return list and hash by reference)
#
  my $unique_instance_ref;
  my $instance_by_instance_ref;
  ($unique_instance_ref,$instance_by_instance_ref) = doSQLinstances();
  
  my $inst;
  foreach $inst (@$unique_instance_ref)
    {
      if (exists $$instance_by_instance_ref{$inst})
        {
          print "#WARNING: instance $inst is the same as instance $$instance_by_instance_ref{$inst}\n";
        }
    }
  
  open(TEMPLATE, $myfile) or die "unable to open $myfile:$!";
  while( $line = <TEMPLATE> )
    {
      if ( (index $line,'<TT CLONE>') != -1 )
        {
          &doSQLclone;
        }
      elsif ( (index $line,'<TT PATHS>') != -1 )
        {
          &doSQLprereqclone;
          &doSQLpaths;
        }
      elsif ( (index $line,'<TT APPEND>') != -1 )
        {
          &doSQLappend;
        }
      elsif ( (index $line,'<TT TALKTOS>') != -1 )
        {
          &doSQLtalktos;
        }
      elsif ( (index $line,'<TT OUTPUT>') != -1 )
        {
	  &doSQLoutput;  
        } 
      else
        {
          print "$line";
        };
    };


  $dbh->rollback;
  $dbh->disconnect;

#---------------------------------------------------
sub doSQLclone  
 {
#  just do STDOUT for now
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
#
#  Loop through all unique instances to get the class name
#   then clone
#
    my $instance;
    foreach $instance (@$unique_instance_ref)
      {
        # use only instances not referred to by other instances
        if (! exists $$instance_by_instance_ref{$instance})
          {
            my ($handle) = $dbh->prepare("select class_name from 
              option_instances where instance_name='$instance'");
            if($DBI::err) {print "$DBI::errstr\n";}
            $handle->execute();
            if($DBI::err) {print "$DBI::errstr\n";}
            my $classname;
            if ($classname = $handle->fetchrow)
              {
                if($DBI::err)
                  {
                    print "$DBI::errstr\n";
                    return;
                  }
                print OUT "mod clone $classname $instance\n";
              }
          }
      }
    print OUT "#\n";
}
#---------------------------------------------------
sub doSQLprereqclone  
  {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
    print OUT "# prereq clones";
#  Need to clone Prereq module for all trigger paths
    my ($handle) = $dbh->prepare("select path_name from trigger_paths");
    if($DBI::err){print "$DBI::errstr\n";}    
    $handle->execute();
    if($DBI::err){print "$DBI::errstr\n";}
    my @results;
    while (@results = $handle->fetchrow)
      {
        if($DBI::err)
          {
            print "$DBI::errstr\n";
            return;
          }
        my($path);
        foreach $path(@results)
          {
            print OUT "# MAKE CLONE OF PREREQ MODULE FOR $path\n";
            print OUT "mod clone Prereq Prereq_$path\n";    
            print OUT "#\n";
          }
      }
    print OUT "#\n";
 }
#---------------------------------------------------
sub doSQLpaths  
 {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
    
# Get the names of all the trigger paths
    my ($handle) = $dbh->prepare("select path_name from trigger_paths");
    if($DBI::err){print "$DBI::errstr\n";}    
    $handle->execute();
    if($DBI::err){print "$DBI::errstr\n";}
    my @results;
    while (@results = $handle->fetchrow)
      {
        if($DBI::err)
          {
            print "$DBI::errstr\n";
            return;
          }
        my($path);
        foreach $path(@results)
          {

#   Need to create a path and add a Prereq module for each trigger path
            print OUT "# CREATE AND ENABLE $path\n";      
            print OUT "#\n";    
            print OUT "path create $path Prereq_$path\n";
# Must remember to enable the trigger path
            print OUT "path enable $path\n";
            print OUT "# \n";
            
#
#  Now must set the trigger bits in the Prereq talk-to 
            print OUT "# SET TRIGGER BITS FOR $path\n";
            print OUT "#\n";
            print OUT "mod talk Prereq_$path\n";
            
            my ($handle) = $dbh->prepare("select trigger_name, trigger_level 
              from trigger_names_trigger_paths where path_name='$path'");
            if($DBI::err){print "$DBI::errstr\n";}
            $handle->execute();
            if($DBI::err){print "$DBI::errstr\n";}
            
            my $L1Mask = 0; 
            my $L2Mask = 0;
            my $L3Mask = 0;
            my @results;
            while (@results = $handle->fetchrow)
              {
                if($DBI::err)
                  {
                    print "$DBI::errstr\n";
                    return;
                  }
                my ($trigger_name) = $results[0];
                chomp $trigger_name;
#                print OUT "#Trigger name is $trigger_name\n";
                my ($trigger_level) = $results[1];
#                print OUT "#Trigger level is $trigger_level\n";
                use integer;  # enable integer arithmatic for bit manipulation
                my $bitmask = 0;
                #
                #  now query all of the triggers in the path to get bitmasks;
                #   the current assumption is that these triggers are "or"
                #   EXCEPT "AutoAccept"s, which are only valid if they
                #   are the only trigger
                #
                my ($handle) = $dbh->prepare("select trigger_bitmask from 
                      trigger_names where trigger_name='$trigger_name' and 
                      trigger_level='$trigger_level'");
                if($DBI::err){print "$DBI::errstr\n";}
                $handle->execute();
                if($DBI::err){print "$DBI::errstr\n";}
                # note coding for AutoAccept -- unable to modify trigger
                #   table
                if ( ($bitmask = $handle->fetchrow) 
                    && ($trigger_name !~"AutoAccept") )
                  {
#                    print OUT "#Bitmask is $bitmask\n";
                    if ($trigger_level == 1)
                      {
                        $L1Mask = $L1Mask | $bitmask;
                      }
                    elsif ($trigger_level == 2)
                      {
                        $L2Mask = $L2Mask | $bitmask;
                      }
                    elsif ($trigger_level == 3)
                      {
                        $L3Mask = $L3Mask | $bitmask;
                      }
                  }
              }
            if ($L1Mask != 0)
              { print OUT "  L1TriggerMask set $L1Mask\n";}
            else
              { print OUT "  L1Accept set true\n";}
            if ($L2Mask != 0)
#
#  note that for MDC-1, L2TriggerMask word 2 is set, rather than
#   word one...
#
              { print OUT "  L2TriggerMask_2 set $L2Mask\n";
                print OUT "  L2TriggerMask_1 set 0\n"; }
            else
              { print OUT "  L2Accept set true\n";}
#
#  regardless of L3Mask, always process Level3 triggers
#
#            if ($L3Mask != 0)
#              { print OUT "  L3TriggerMask_1 set $L3Mask\n";
#                print OUT "  L3TriggerMask_2 set 0\n"; }
#            else
              { print OUT "  L3Accept set true\n";}
          } # loop over paths
        print OUT "exit\n\n";
      }
  }
#---------------------------------------------------
sub doSQLappend
 {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
    
# Get the names of all the trigger paths
    my ($handle) = $dbh->prepare("select path_name from trigger_paths");
    if($DBI::err){print "$DBI::errstr\n";}    
    $handle->execute();
    if($DBI::err){print "$DBI::errstr\n";}
    my @results;
    while (@results = $handle->fetchrow)
      {
        if($DBI::err)
          {
            print "$DBI::errstr\n";
            return;
          }
        my($path);
        foreach $path(@results)
          {
            #   Now get a list of all the modules 
            #      instances needed for that trigger
            #      path and put them in the correct run order
            my ($printedappend) = 0;
            my ($handle) = $dbh->prepare("select trigger_name, 
            trigger_level from 
            trigger_names_trigger_paths where 
            path_name='$path'");
            if($DBI::err){print "$DBI::errstr\n";}
            $handle->execute();
            if($DBI::err){print "$DBI::errstr\n";}
            my $tname; my @tinfo;
            while (@tinfo = $handle->fetchrow)
            {
              #  print OUT "triggers of $path are @tinfo\n";
              $tname = $tinfo[0];
              chomp $tname;
              my ($level) = $tinfo[1];
              if($DBI::err)
                {
                  print "$DBI::errstr\n";
                  return;
                }
              if ($level == 3)
                {
                  my ($handle) = $dbh->prepare("select instance_name from 
                     option_sequences where 
                     trigger_name='$tname' order by opt_sequence");
                  if($DBI::err){print "$DBI::errstr\n";}
                  $handle->execute();
                  if($DBI::err){print "$DBI::errstr\n";}
                  my $instance;
                  while ($instance = $handle->fetchrow)
                    {
                      if ($printedappend == 0)
                        {
                          $printedappend = 1;
                          print OUT "path append $path ";
                        }
                      #   print OUT "instances of $tname are $instance\n";
                      #
                      #  remember to use unique instance name
                      #
                      my $rootinst = $instance;
                      if ( exists $$instance_by_instance_ref{$instance} )
                        {
                          $rootinst = $$instance_by_instance_ref{$instance};
                        }
                      print OUT "$rootinst ";
                      if($DBI::err)
                        {
                          print "$DBI::errstr\n";
                          return;
                        }
                    }
                  print OUT "\n";
    	          print OUT "#\n";    
                }
            } 
            
          }
      }
  }
  
#---------------------------------------------------
sub doSQLtalktos  
 {
    my $instance;

    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";

    foreach $instance (@{$unique_instance_ref})
      {
        # use only instances not referred to by other instances
        if (! exists $$instance_by_instance_ref{$instance})
          {
            #  Talk-to each module instance
            print OUT "# TALK-TO FOR $instance\n";
            print OUT "#\n";
            print OUT "mod talk $instance\n";
            #  Get the name of the talk-to variable 
            my ($handle) = $dbh->prepare("select name from cut_and_parameters  
                         where instance_name='$instance'");
            if($DBI::err){print "$DBI::errstr\n";}
            $handle->execute();
            if($DBI::err){print "$DBI::errstr\n";}
            my $name;
            my @name_list;
            while ($name = $handle->fetchrow)
              { 
                if($DBI::err)
                  {
                    print "$DBI::errstr\n";
                    return;
                  }
                push @name_list, $name;
              }
            #  For each talk-to name get its talk-to menu and value
            foreach $name (@name_list)
              {
                my ($handle) = $dbh->prepare("select menu from talktos, 
            option_classes, option_instances where 
            talktos.name='$name' and 
            talktos.class_name=option_classes.class_name and 
            option_classes.class_name=option_instances.class_name and 
            option_instances.instance_name='$instance'");
                if($DBI::err){print "$DBI::errstr\n";}
                $handle->execute();
                if($DBI::err){print "$DBI::errstr\n";}
                my $menu;
                my $prev_menu = 'aaa';
                while ($menu = $handle->fetchrow)
                  {  
                    if($DBI::err)
                      {
                        print "$DBI::errstr\n";
                        return;
                      }
                    unless ($prev_menu =~ /$menu/)
                      {	
                        $prev_menu = $menu;
                        my @submenu = split(/\//,$menu);
                        if ($submenu[1] =~ /\w/) 
                          {
                            my $temp = $submenu[1];  
                            print OUT "    $temp\n";
                            my ($handle) = $dbh->prepare("select value from 
                           cut_and_parameters where 
                           instance_name='$instance' and name='$name'");
                            $handle->execute();
                            my $value;
                            $value = $handle->fetchrow;
                            if ($value) 
                              {
                                print OUT "      $name set $value\n";
                              }
                            print OUT "    exit\n";
                          }
                        else
                          {
                            my ($handle) = $dbh->prepare("select value from 
                           cut_and_parameters, option_instances, 
                           option_classes, talktos where 
                           option_instances.instance_name='$instance' and  
                           cut_and_parameters.name='$name' and 
                           option_instances.class_name=option_classes.class_name and 
                           option_classes.class_name=talktos.class_name and 
                           talktos.menu='/'");
                            if($DBI::err) {print "$DBI::errstr\n";}
                            $handle->execute();
                            if($DBI::err) {print "$DBI::errstr\n";}
                            my $value;
                            $value = $handle->fetchrow;
                            if ($value) {print OUT "  $name set $value\n";}
                          }
                      }
                  }	  
              }
            
            print OUT "exit\n";
            print OUT "#\n";   
          }
      }
  }

#---------------------------------------------------
sub doSQLinstances
 {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
#
#    Get name of all instances in active paths
#
    my ($handle) = $dbh->prepare("select path_name from 
                                  trigger_names_trigger_paths");
    if($DBI::err){print "$DBI::errstr\n";}    
    $handle->execute();
    if($DBI::err){print "$DBI::errstr\n";}
    my $instance;
    my @instance_list;
    my $path;
    while ($path = $handle->fetchrow)
      {
        if($DBI::err)
          {
            print "$DBI::errstr\n";
            return;
          }
#      	print "path name is $path\n";
        my ($handle) = $dbh->prepare("select instance_name from 
             option_sequences, trigger_names, trigger_names_trigger_paths 
             where trigger_names_trigger_paths.path_name='$path' and 
           trigger_names_trigger_paths.trigger_name=trigger_names.trigger_name
             and trigger_names.trigger_name=option_sequences.trigger_name and 
             trigger_names.trigger_level=3");
        if($DBI::err) {print "$DBI::errstr\n";}
        $handle->execute();
        if($DBI::err) {print "$DBI::errstr\n";}
        while ($instance = $handle->fetchrow)
           {
             if($DBI::err)
              {
                print "$DBI::errstr\n";
                return;
              }
             push @instance_list, $instance;
           }
      }
#
#  remove duplicate instance names
#
     @instance_list = sort @instance_list;
     my @unique_instance;
     my $last_instance;
     foreach $instance (@instance_list)
       {
#            print "$name,$lastname\n";
          if ($instance ne $last_instance) 
            {
                push @unique_instance, $instance;
            }
          $last_instance = $instance;
       }

#
#  now we need to check for instances that have different names,
#   but the same class and talk-to entries
#
    my %instance_by_instance = ();
#
#  first, build a hash table of the classnames and talktos
#
    my %class_by_instance = ();
# hash of lists
    my %talkto_by_instance = ();
# hash of hashes
    my %value_by_instance_by_talkto = ();
    my @tmpnames;
    foreach $instance (@unique_instance)
      {
        @tmpnames = ();
        #  Get the name of class
        my ($handle) = $dbh->prepare("select class_name from 
              option_instances where instance_name='$instance'");
        if($DBI::err){print "$DBI::errstr\n";}
        $handle->execute();
        if($DBI::err){print "$DBI::errstr\n";}
        if (my $classname = $handle->fetchrow)
          { 
            $class_by_instance{$instance}=$classname;
          }
        #  Get names of talk-tos
        my ($handle) = $dbh->prepare("select name from 
                         cut_and_parameters  
                         where instance_name='$instance'");
        if($DBI::err){print "$DBI::errstr\n";}
        $handle->execute();
        if($DBI::err){print "$DBI::errstr\n";}
        while (my $name = $handle->fetchrow)
          { 
            if($DBI::err)
              {
                print "$DBI::errstr\n";
                return;
              }
            push @tmpnames, $name;
            my ($handle) = $dbh->prepare("select value from 
                           cut_and_parameters where 
                           instance_name='$instance' and name='$name'");
            if($DBI::err){print "$DBI::errstr\n";}
            $handle->execute();
            if($DBI::err){print "$DBI::errstr\n";}
            if (my $value = $handle->fetchrow)
              {  
                if($DBI::err)
                  {
                    print "$DBI::errstr\n";
                    return;
                  }
                $value_by_instance_by_talkto{$instance}{$name} = $value;
              }
            else
              {
                $value_by_instance_by_talkto{$instance}{$name} = " ";
              }
          }
        # enter into the hash of lists
        $talkto_by_instance{$instance} = [ @tmpnames ];
      }
    #
    #  now loop over all instances
    #
    my $inst1; my $inst2;
    my $equiv = 1;
    my $ttname;
    foreach $inst1 (@unique_instance)
      {
        foreach $inst2 (@unique_instance)
          {
            #
            #  look for different instances with same class
            #
            if ( ($inst1 cmp $inst2) == 1 )
              {
                if ($class_by_instance{$inst1} eq $class_by_instance{$inst2})
                  {
#                    print "# comparing $inst1 and $inst2\n";
#                    print "#  here are all the talk-tos @{$talkto_by_instance{$inst1}}\n";
                    $equiv = 1;
                    # check that all talk-tos in inst1 are in inst2
                    #  check also values
                    foreach $ttname (@{$talkto_by_instance{$inst1}})
                      {
#                        print "#  checking talkto $ttname\n";
                        if ( grep($ttname,@{$talkto_by_instance{$inst2}}) )
                          {
                            if ( 
                                $value_by_instance_by_talkto{$inst1}{$ttname} 
                              ne $value_by_instance_by_talkto{$inst2}{$ttname} 
                            &&  $value_by_instance_by_talkto{$inst1}{$ttname} 
                              != $value_by_instance_by_talkto{$inst2}{$ttname}
                               )
                              {
#                                print "#  different value:";
#                                print " $value_by_instance_by_talkto{$inst1}{$ttname}, $value_by_instance_by_talkto{$inst2}{$ttname}\n";
                                $equiv = 0;
                              }
                          }
                        else
                          {
#                            print "#  not found\n";
                            $equiv = 0;
                          }
                      }
                    # check that all talk-tos in inst2 are in inst1
                    foreach $ttname (@{$talkto_by_instance{$inst2}})
                      {
#                        print "#  checking talkto $ttname\n";
                        if ( ! grep($ttname,@{$talkto_by_instance{$inst1}}) )
                          {
#                            print "#  not found\n";
                            $equiv = 0;
                          }
                      }
                    my $rootinst = $inst1;
                    if ($equiv)
                      {
                        #
                        #  if they are the same instance, then
                        #   map in instance_by_instance hash to the
                        #   root equivalent instance
                        #
                        while ( exists $instance_by_instance{$rootinst} )
                          {
                            my $tmp = $instance_by_instance{$rootinst};
                            $rootinst = $tmp;
                          }
                        $instance_by_instance{$inst2} = $rootinst;
                      }
                  }
              }
          }
      }
    return (\@unique_instance,\%instance_by_instance);
  }

#---------------------------------------------------
  sub doSQLoutput  {

    #  just do STDOUT for now
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
 
    my ($handle) = $dbh->prepare("select logger_datastream from datasets");
    if($DBI::err){print "$DBI::errstr\n";}    
    $handle->execute();
    if($DBI::err){print "$DBI::errstr\n";}
    my $stream;
    my @stream_list;
    while ($stream = $handle->fetchrow)
      {
        if($DBI::err)
          {
            print "$DBI::errstr\n";
            return;
          }
        push @stream_list, $stream;
      }
     
#
#  remove duplicate stream names
#
	@stream_list = sort @stream_list;
	my @unique_stream;
	my $last_stream;
	foreach $stream (@stream_list)
	  {
#            print "$name,$lastname\n";
            if ($stream ne $last_stream) 
              {
                push @unique_stream, $stream;
              }
            $last_stream = $stream;
          }


    foreach $stream (@unique_stream)
      {
        my $path;
        my @path_list;
#	print "stream is $stream\n";
	print OUT "output create $stream $stream.tmp\n";
	print OUT "output path $stream ";
	my ($handle) = $dbh->prepare("select path_name from 
                 datasets_trigger_paths, datasets where  
                 datasets.logger_datastream='$stream' and 
                 datasets.dataset=datasets_trigger_paths.dataset"); 
        if($DBI::err){print "$DBI::errstr\n";}    
        $handle->execute();
        if($DBI::err){print "$DBI::errstr\n";}
	while ($path = $handle->fetchrow)
          {
            if($DBI::err)
              {
                print "$DBI::errstr\n";
                return;
              }
	    push @path_list, $path;
	  }  
#
#  remove duplicate path names
#
	@path_list = sort @path_list;
	my @unique_path;
	my $last_path;
	foreach $path (@path_list)
	  {
#            print "$name,$lastname\n";
            if ($path ne $last_path) 
              {
                push @unique_path, $path;
              }
            $last_path = $path;
          }

	foreach $path (@unique_path)
	  {
	      print OUT "$path ";
          }

      	print OUT "\n";
   
     }
 }
#---------------------------

 }