#!perl
#

package buildInput;

use strict;

use Exporter ();
use vars qw(@ISA @EXPORT);
BEGIN {
  @ISA = qw(Exporter);
  @EXPORT = qw(&getInput &doSQLclone &doSQLpaths &doSQLappend &doSQLtalktos &doSQLinstances &doSQLoutput &doSQLgetPaths &doSQLgetStreams &reportDbError);
}

1;

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

sub getInput {

  use DBI;
  use strict;
  
  open (OUT, ">-") || die "I/O error accessing STDOUT:$!";   
  
  # first argument is the stream_name_used flag
  $main::stream_name_used = shift;
# Name of tcl template to use
  my $template = shift;
#  these are the names of the physics table and tag 
#  (passed in as arguments)
  $main::phys_table = shift;
  $main::phys_table_tag = shift;
  print OUT "#Physics Table name and tag are: $main::phys_table, $main::phys_table_tag\n";
  
# Removed use of test.user for connecting to database, using the 
# cdf_reader login which is READ ONLY.  Which database to connect
# to is now passed in as an argument - KAT 10/17/00
  my $dbname = shift;
  my $user = "cdf_reader";
  my $password = "reader";
# Hard wiring password and username for development database since
# a cdf_reader which sees the trigger tables doesn't exist on cdfondev
  if ($dbname eq "cdfondev")
  {
#      $user = "level3_trig_dev";
#      $password = "level3";
      $user = "cdftrig_dev";
      $password = "cdftrig_dev";
  }

# Read the database, username and password from a file
# The file must be three lines with database, username and password
# on separate lines.  There must be no blank lines at the
# end of the file.

#  open (USERNAME,"test.user") || die "can't open file: $!";
#  while (defined ($temp = <USERNAME>)) 
#  {
#      chomp $temp;
#      $dbname = $temp;
#      $user=<USERNAME>;
#      chomp $user;
#      $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
#
  ($main::dbh) = DBI->connect("dbi:Oracle:$dbname",$user,$password) ||
    die "Error connecting $DBI::errstr\n";

  my $myfile=$template;
  my $line;
  
#
#  now get the unique instances (return list and hash by reference)
#
  ($main::unique_instance_ref,$main::instance_by_instance_ref,$main::class_by_instance_ref) = doSQLinstances();
  
  my $inst;
  foreach $inst (@$main::unique_instance_ref)
    {
      if (exists $$main::instance_by_instance_ref{$inst})
        {
          print "#WARNING: parmSetName $inst for class $$main::class_by_instance_ref{$inst} is the same as parmSetName $$main::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 )
        {
	  # Dave Waters, 7.5.2002. Pass null Prereq module clone name prefix.
          &doSQLprereqclone('');
# create paths using just level 1 and 2 prerequisites
#          &doSQLpaths('',1,2);
# remove check on Level-1 bit... this seems unwise, but if the TDWG
#  says jump, by golly...  KSM 6/19/02
          &doSQLpaths('',2);

        }
      elsif ( (index $line,'<TT APPEND>') != -1 )
        {
          &doSQLappend;
        }
      elsif ( (index $line,'<TT TALKTOS>') != -1 )
        {
          &doSQLtalktos;
        }
      elsif ( (index $line,'<TT OUTPUT>') != -1 )
        {
     	  &doSQLoutput;  
          &doSQLgetpathinfo;
        } 
      else
        {
          print "$line";
        };
    };

  $main::dbh->rollback;
  $main::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 (@$main::unique_instance_ref)
      {
        # use only instances not referred to by other instances
        if (! exists $$main::instance_by_instance_ref{$instance})
          {
            my $classname = $$main::class_by_instance_ref{$instance};
# syntax for clone is
#    mod clone [className] [parmSetName]
#
#   "parmSetName" is what we previously called (and what is in the databae)
#       as the "instance_name" in the module_instances table
#
# the actual name of the instance of the module created by this command
#   is  $classname.'-'.$instance
#
            my $createdInstance = $classname.'-'.$instance;
            print OUT "# creating instance $createdInstance of class $classname\n";
            print OUT "mod clone $classname $instance\n";
# disable original module
	    print OUT "mod disable $classname\n";
          }
      }
    print OUT "#\n";
}
#---------------------------------------------------
sub doSQLprereqclone  
  {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";

    # Dave Waters, 7.5.2002. Get the prefix to the Prereq module clone name
    # passed as an argument.
    my $prereq_prefix = $_[0];
    # print "prereq_prefix = $prereq_prefix \n";

    #    print OUT "# prereq clones\n";
    print OUT "# MAKE CLONE OF PREREQ MODULES\n";
    print OUT "#\n";

    #  Need to clone Prereq module for all trigger paths

    my @List;
    my $ref_to_list = &doSQLgetPaths;
    @List = @$ref_to_list;
    my $path;
    my @path;
    foreach $path(@List)
      {
	
	# the list from doSQLgetPaths returns a joined list of paths and 
	# tags, so we need to split the path from the tag...
	@path= split /:/, $path; 
	# creates an instance named "Prereq-$path[0]_v$path[1]"
	
	#  Dave Waters, 07.05.2002. Check argument to see if a
	#  a clone name prefix has been specified :
	if ($prereq_prefix eq '')
	  {
	    print OUT "mod clone Prereq $path[0]_v$path[1]\n";
	  }
	else
	  {
	    print OUT "mod clone Prereq ${prereq_prefix}_$path[0]_v$path[1]\n";
	  }
      }
    print OUT "#\n";
    #  disable base (uncloned) Prereq module
    print OUT "mod disable Prereq\n";
    print OUT "#\n";
 }
#---------------------------------------------------
sub doSQLgetpathinfo  
  {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
    print OUT "# List of trigger path data\n";
    print OUT "#\n";
#  Need to clone Prereq module for all trigger paths

    my @List;
    my $ref_to_list = &doSQLgetPaths;
    @List = @$ref_to_list;
    my @trigger_list;
    my $path;
    my @path;
    my $path_counter = 0; #L3 Path Bit starts at 0! KAT 8/1/01
    foreach $path(@List)
      {
        
# the list from doSQLgetPaths returns a joined list of paths and 
# tags, so we need to split the path from the tag...
        @path= split /:/, $path; 
# Now for this list of paths need to get the path id from db
        my ($handle) = $main::dbh->prepare("select path_id from 
              trigger_paths where trigger_paths.path_name='$path[0]' and 
              trigger_paths.path_tag='$path[1]'");
        if($DBI::err)
          {&buildInput::reportDbError("fetching path id:",
                                      $DBI::errstr);}
        $handle->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching path id:",
                                      $DBI::errstr);}
        
        my $path_id = $handle->fetchrow;
        
        print OUT "   L3PathNames add $path[0]_v$path[1]\n";
        print OUT "   L3PathIds add $path_id \n";
        print OUT "   L3PathBits add $path_counter \n"; $path_counter++;
        
# For this path get the datasets and dataset ids
        $handle = $main::dbh->prepare("select 
         datasets_trigger_paths.dataset_name, 
         datasets_trigger_paths.dataset_tag from 
              datasets_trigger_paths,datasets_physics_tables where 
        datasets_physics_tables.physics_table_name='$main::phys_table' and
        datasets_physics_tables.physics_table_tag ='$main::phys_table_tag' and 
  datasets_trigger_paths.dataset_name=datasets_physics_tables.dataset_name and 
  datasets_trigger_paths.dataset_tag=datasets_physics_tables.dataset_tag and
              path_name='$path[0]' and 
              path_tag='$path[1]'");  
        if($DBI::err)
          {&buildInput::reportDbError("fetching dataset name:",
                                      $DBI::errstr);}
        $handle->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching dataset name:",
                                      $DBI::errstr);}
        
        my @dataset_name = $handle->fetchrow;
        my $handle6 = $main::dbh->prepare("select dataset_id from 
              datasets, datasets_physics_tables where 
              datasets.dataset_name='$dataset_name[0]' and 
              datasets.dataset_tag='$dataset_name[1]'");
        
        if($DBI::err)
          {&buildInput::reportDbError("fetching dataset id:",
                                      $DBI::errstr);}
        $handle6->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching dataset id:",
                                      $DBI::errstr);}
        
        my $dataset_id = $handle6->fetchrow;
        print OUT "   L3PathDatasetNames add $dataset_name[0]_v$dataset_name[1] \n";
        print OUT "   L3PathDatasetIds add $dataset_id \n";

# Now for this path get trigger info
        my ($handle1) = $main::dbh->prepare("select trigger_name, 
           trigger_tag from 
           trigger_names_trigger_paths where  
           path_name='$path[0]' and path_tag='$path[1]'");
        
        if($DBI::err)
          {&buildInput::reportDbError("fetching trigger info:",
                                      $DBI::errstr);}
        $handle1->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching trigger info:",
                                      $DBI::errstr);}
        
        while (my @trigger_info = $handle1->fetchrow)
          {
            my $trigger_key = join ":", @trigger_info;
            push @trigger_list, $trigger_key;
          }
      }  # end loop over paths

# make unique list of triggers

    @trigger_list = sort @trigger_list;
    my @unique_trigger;
    my $last_trigger = -1; my $ttrigger;
    foreach $ttrigger (@trigger_list)
      {
        if ($ttrigger ne $last_trigger){
          push @unique_trigger,$ttrigger;}
        $last_trigger=$ttrigger;
      }

# now go through trigger list and extract information

    foreach my $trigger_key (@unique_trigger)
      {
        my @trigger_info = split /:/,$trigger_key;
        my ($handle2) = $main::dbh->prepare("select trigger_id, 
           trigger_level from 
           trigger_names where trigger_name='$trigger_info[0]' and
           trigger_tag='$trigger_info[1]'");
        
        if($DBI::err)
          {&buildInput::reportDbError("fetching trigger id  info:",
                                      $DBI::errstr);}
        $handle2->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching trigger id info:",
                                      $DBI::errstr);}
        
        my @trigger_id = $handle2->fetchrow;

# get trigger bit        
        my ($handle3) = $main::dbh->prepare("select bit_no from 
             trigger_bitmasks where trigger_name='$trigger_info[0]' and 
             trigger_level = '$trigger_id[1]' and 
                      trigger_tag='$trigger_info[1]' and 
                      physics_table_name='$main::phys_table' and
                      physics_table_tag ='$main::phys_table_tag'");

        if($DBI::err)
          {&buildInput::reportDbError("fetching trigger bit:",
                                      $DBI::errstr);}
        $handle3->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching trigger bit:",
                                      $DBI::errstr);}
        my $bit_success = defined(my $trig_bit = $handle3->fetchrow);
        if($DBI::err)
          {&buildInput::reportDbError("fetching trigger bit:",
                                      $DBI::errstr);}

# For Levels 1 and 2, output the information

        if ($trigger_id[1] == 1)
          {    
            print OUT "   L1TriggerNames add $trigger_info[0]_v$trigger_info[1] \n";
            print OUT "   L1TriggerIds add $trigger_id[0] \n";
            if ( $bit_success ) {
              print OUT "   L1TriggerBits add $trig_bit \n";
            }
            else {
              print OUT "   L1TriggerBits add -1 \n";
              &buildInput::reportDbError("L1 trigger without a bit (trigger info):",
                                    $trigger_info[0]."_v".$trigger_info[1]);
            }
          }
        elsif ($trigger_id[1] == 2)
          {    
            print OUT "   L2TriggerNames add $trigger_info[0]_v$trigger_info[1] \n";
            print OUT "   L2TriggerIds add $trigger_id[0] \n";
            if ( $bit_success ) {
              print OUT "   L2TriggerBits add $trig_bit \n";
            }
            else {
              print OUT "   L2TriggerBits add -1 \n";
              &buildInput::reportDbError("L2 trigger without a bit (trigger info):",
                                    $trigger_info[0]."_v".$trigger_info[1]);
            }
          }
      }
}
#---------------------------------------------------
sub doSQLpaths  
 {
     open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
    
     # copy input arguments (trigger levels to use) to Levels 
     # Dave Waters, 7.5.2002. Pass Prereq module clone name prefix in addition :
     my $prereq_prefix;
     my @Levels;
     ($prereq_prefix,@Levels) = @_;
     # print "Prereq_prefix = $prereq_prefix \n";
     # print "Levels = @Levels \n";

# Get the names of all the trigger paths used with this physics table
     my @List;
     my $ref_to_list = &doSQLgetPaths;
     @List = @$ref_to_list;
     my $path;
     my @path;
 
   #make sure that a list of trigger paths was returned
    if (defined @List)
    {
    }
    else
    {
	warn "WARNING : $main::phys_table may be empty - NULL trigger_path list returned\n";
	
    }

     print OUT "# CREATE, ENABLE AND SET BITS FOR TRIGGER PATHS\n";      
     print OUT "#\n";    

     my $pathCount = 0;

     foreach $path(@List)
     {
# the list from doSQLgetPaths returns a joined list of paths and 
# tags, so we need to split the path from the tag...

	@path= split /:/, $path; 

	# Dave Waters, 7.5.2002 : Check to see if a Prereq module clone name prefix
	# was specified :
	if ($prereq_prefix eq '')
	  {
	    #   Need to create a path and add a Prereq module for each trigger path
	    print OUT "path create $path[0]_v$path[1] Prereq-$path[0]_v$path[1]\n";
	    # Must remember to enable the trigger path
	    print OUT "path enable $path[0]_v$path[1]\n";
	    print OUT "mod talk Prereq-$path[0]_v$path[1]\n";
	  }
	else
	  {
	    print OUT "path create $path[0]_v$path[1] Prereq-${prereq_prefix}_$path[0]_v$path[1]\n";
	    print OUT "path enable $path[0]_v$path[1]\n";
	    print OUT "mod talk Prereq-${prereq_prefix}_$path[0]_v$path[1]\n";
	  }
#
#  If Level3 is not in list, now must set the prescale
 
    if ( grep (/3/,@Levels) == 0 )
      {
        my ($handle) = $main::dbh->prepare("select l3_prescale from
              trigger_paths
              where path_name='$path[0]' and path_tag='$path[1]'");
        if($DBI::err){&buildInput::reportDbError("fetching prescale:",
                                                 $DBI::errstr);}
        $handle->execute();
        if($DBI::err){
          if ($DBI::errstr =~ "invalid column")
            {&buildInput::reportDbError("#WARNING: using version of trigger database without prescale\n");}
          else 
            {&buildInput::reportDbError("fetching prescale:",
                                        $DBI::errstr);}
        }
        
        if (defined(my $prescale = $handle->fetchrow))
          {
            if ( ($prescale < 1) && ($prescale > 0) )
              {
                # only supported in 3.12.0 or later in Prereq
                print OUT "  randomPrescale set $prescale\n"
              }	 
            else 
              {
                if ($prescale > 1)
                  {
                    # only supported in 3.12.0 or later in Prereq
                    print OUT "  integralPrescale set $prescale\n"
                  }
              }
          }
      } # do prescale only if not level-3 in selection
#
#  Now must set the trigger bits in the Prereq talk-to

# Use TFRD bank for 1x8 - removed 6/19/02 KSM
#	print OUT "  GetL1TriggerBitsFromTFRD set true\n";
# Use TL2D for L1 bits, 6/19/02 KSM
    print OUT "  GetL1TriggerBitsFromTFRD set false\n";
    print OUT "  GetL1TriggerBitsFromTL2D set true\n";

    my ($handle) = $main::dbh->prepare("select trigger_name,
              trigger_tag, trigger_level from trigger_names_trigger_paths 
              where path_name='$path[0]' and path_tag='$path[1]'");
    if($DBI::err)
      {&buildInput::reportDbError("fetching trigger name:",
                                  $DBI::errstr);}
    $handle->execute();
    if($DBI::err)
      {&buildInput::reportDbError("fetching trigger name:",
                                  $DBI::errstr);}
	 
# three level trigger mask
	 my @Mask = (-1,-1,-1); 
	 my @results;
	 while (@results = $handle->fetchrow)
	 {
	     if($DBI::err)
	     {
           &buildInput::reportDbError("fetching trigger name:",$DBI::errstr);
           return;
	     }
	     my ($trigger_name) = $results[0];
	     chomp $trigger_name;
#                print OUT "#Trigger name is $trigger_name\n";
	     my ($trigger_tag) = $results[1];
	     my ($trigger_level) = $results[2];
#                print OUT "#Trigger level is $trigger_level\n";
	     use integer;  # enable integer arithmatic for bit manipulation
	     #
	     #  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) = $main::dbh->prepare("select bit_no from 
                      trigger_bitmasks where trigger_name='$trigger_name' and 
                      trigger_level='$trigger_level' and 
                      trigger_tag='$trigger_tag' and 
                      physics_table_name='$main::phys_table' and
                      physics_table_tag ='$main::phys_table_tag'");
         if($DBI::err)
           {&buildInput::reportDbError("fetching trigger bit:",
                                       $DBI::errstr);}
	     $handle->execute();
         if($DBI::err)
           {&buildInput::reportDbError("fetching trigger bit:",
                                       $DBI::errstr);}
# note kludge for level-3 trigger bit -> standin for this is path #
         if ( $trigger_level == 3 )
           {
             if ( grep(/$trigger_level/,@Levels) != 0 ){ 
               print OUT 
        "#WARNING: using Level-3 path index in place of trigger bit\n";
# for case of production splitter (which is only time we'd have
# level 3 used in selection) we need to tell prereq to NOT select
# on TL3D - smd 12/23/02
	       print OUT "  GetL3TriggerBitsFromTL3D set false\n";
             }
             if ( $Mask[$trigger_level-1] != -1 )
               {
                 &buildInput::reportDbError(
                   "multiple Level-$trigger_level triggers in path ", 
                                            $path);
                 my ($handle) = $main::dbh->prepare(
                                   "select tntp.trigger_name
                               from trigger_names_trigger_paths tntp,
                                    trigger_names tn 
              where path_name='$path[0]' and path_tag='$path[1]'
                  and tn.trigger_name=tntp.trigger_name
                  and tn.trigger_tag=tntp.trigger_tag
                  and tn.trigger_level='$trigger_level'");
                 if($DBI::err)
                   {&buildInput::reportDbError(
                                "fetching trigger name:",$DBI::errstr);}
                 $handle->execute();
                 if($DBI::err)
                   {&buildInput::reportDbError(
                                "fetching trigger name:",$DBI::errstr);}
                 while (my $trigger_name = $handle->fetchrow)
                   {
                     &buildInput::reportDbError(
                        "   contains Level-$trigger_level trigger ",
                                                $trigger_name);
                   }
               }
             $Mask[$trigger_level-1] = $pathCount;
           }
         else # not Level-3
           {
             my $bit;
             if ( ! defined($bit = $handle->fetchrow))
               {
                 $bit = -1;
               }
             if ($bit ge '0' )
               {
                 if ( $Mask[$trigger_level-1] != -1 )
                   {
                     &buildInput::reportDbError(
                       "multiple Level-$trigger_level triggers in path ", 
                                                $path);
                     my ($handle) = $main::dbh->prepare(
                                "select tntp.trigger_name
                               from trigger_names_trigger_paths tntp,
                                    trigger_names tn 
              where path_name='$path[0]' and path_tag='$path[1]'
                  and tn.trigger_name=tntp.trigger_name
                  and tn.trigger_tag=tntp.trigger_tag
                  and tn.trigger_level='$trigger_level'");
                     if($DBI::err)
                       {&buildInput::reportDbError(
                                 "fetching trigger name:",$DBI::errstr);}
                     $handle->execute();
                     if($DBI::err)
                       {&buildInput::reportDbError(
                                "fetching trigger name:",$DBI::errstr);}
                     while (my $trigger_name = $handle->fetchrow)
                       {
                         &buildInput::reportDbError(
                          "   contains Level-$trigger_level trigger ",
                                            $trigger_name);
                       }
                   }
                 $Mask[$trigger_level-1] = $bit;
               }
             else
               {
                 &buildInput::reportDbError("L".$trigger_level.
                        " trigger requirement without a bit in Prereq:",
                                            $trigger_name);
               }
           }
         if($DBI::err)
           {&buildInput::reportDbError("fetching trigger bit:",
                                       $DBI::errstr);}
#                print OUT "#Bit requested is $bit at Level $trigger_level\n";
       }

# if Level-n prerequisites

#    my $mask; my $alevel;
#    print OUT "# mask:";
#    foreach $mask (@Mask)
#      { print OUT "$mask, "; }
#    print OUT "\n# levels:";
#    foreach $alevel (@Levels)
#      { print OUT "$alevel, "; }
#   print OUT "\n";

    my $level;
    foreach $level ( (1,2,3) )
      {
#        if ($level != 2)
#         { 
          if ( grep(/$level/,@Levels) ) 
           {
            if ($Mask[$level-1] != -1)
              { 
                print OUT "  L".$level."Accept set false\n";
                print OUT "  L".$level."TriggerBits set $Mask[$level-1]\n";
              }
            else # no prereq
              { print OUT "  L".$level."Accept set true\n";}
           }
          else  # no prereq
            { print OUT "  L".$level."Accept set true\n";}
#         }
# TWG says to start cutting on L2 trigger bits so remove hardcoded 
# L2Accept lines - KAT 12/06/01
# NO TL2D bank for 1x8 so need have L2Accept set true for now. 4/2/01 KAT
#        else  #ignore Level-2 prereq for now
#         { print OUT "  L".$level."Accept set true\n";}
      }

    # end loop over paths
     print OUT "exit\n";
     print OUT "# \n";
    $pathCount++; # increment path count
    }
 }
#---------------------------------------------------
sub doSQLappend
 {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
    
# Get the names of all the trigger paths
    my @List;
    my $ref_to_list = &doSQLgetPaths;
    @List = @$ref_to_list;
    my @path;
    my $path;
    foreach $path(@List)
    {
# the list from doSQLgetPaths returns a joined list of paths and 
# tags, so I need to split the path from the tag...

	@path= split /:/, $path; 

	#   Now get a list of all the modules 
	#      instances needed for that trigger
	#      path and put them in the correct run order
	my ($handle) = $main::dbh->prepare("select trigger_name, 
            trigger_tag, trigger_level from 
            trigger_names_trigger_paths where 
            path_name='$path[0]'and path_tag='$path[1]'");
    if($DBI::err)
      {&buildInput::reportDbError("fetching trigger name:",
                                  $DBI::errstr);}
	$handle->execute();
    if($DBI::err)
      {&buildInput::reportDbError("fetching trigger name:",
                                  $DBI::errstr);}
	my $tname; my @tinfo;
	while (@tinfo = $handle->fetchrow)
	{
	    #  print OUT "triggers of $path are @tinfo\n";
	    $tname = $tinfo[0];
	    chomp $tname;
	    my $ttag = $tinfo[1];
	    my $level= $tinfo[2];

	    if($DBI::err)
	    {
          &buildInput::reportDbError("fetching trigger name:",$DBI::errstr);
          return;
	    }
	    if ($level == 3)
	    {
		my ($handle) = $main::dbh->prepare(
                    "select instance_name, filter_type from 
                     l3_option_sequences where 
                     trigger_name='$tname' and trigger_tag='$ttag'
                     and trigger_level='$level' 
                     order by opt_sequence");
        if($DBI::err)
          {&buildInput::reportDbError("fetching instance info:",
                                      $DBI::errstr);}
		$handle->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching instance info:",
                                      $DBI::errstr);}
        my @instance;
		while (@instance = $handle->fetchrow)
          {
		    if($DBI::err)
              {
                &buildInput::reportDbError("fetching instance info:",
                                      $DBI::errstr);
                return;
              }
            my $instance_name = $instance[0];
            my $classname = $$main::class_by_instance_ref{$instance_name};
            #  convert filter type to lower case
            my $filter_type = lc $instance[1];
            #
		    #   print OUT "instances of $tname are $instance_name\n";
		    #
		    #  remember to use unique instance name
		    #
		    my $rootinst = $instance_name;
		    if ( exists $$main::instance_by_instance_ref{$instance_name} )
              {
                $rootinst = $$main::instance_by_instance_ref{$instance_name};
              }
#  the instance name of the module is now "$classname-$instance"
		    print OUT "path append $path[0]_v$path[1] $classname-$rootinst \n";
            if ( $filter_type eq "off" || $filter_type eq "veto" )
              {
                print OUT "filter -path $path[0]_v$path[1] $classname-$rootinst $filter_type\n";
              }
          }
		print OUT "#\n";    
	    }
	} 
	
    }
}
  
#---------------------------------------------------
sub doSQLtalktos  
 {
    my $instance;

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

    foreach $instance (@{$main::unique_instance_ref})
      {
        # use only instances not referred to by other instances
        if (! exists $$main::instance_by_instance_ref{$instance})
          {
            my $classname = $$main::class_by_instance_ref{$instance};
            #  Talk-to each module instance
            print OUT "# TALK-TO FOR $classname-$instance\n";
            print OUT "#\n";
            print OUT "mod talk $classname-$instance\n";
            #  Get the name and menu of the talk-to variable 
            my ($handle) = $main::dbh->prepare("select 
                  name, menu, value, instance_name from 
                  l3_cut_and_parameters where instance_name='$instance'");
            if($DBI::err)
              {&buildInput::reportDbError("fetching talk-to:",
                                      $DBI::errstr);}
            $handle->execute();
            if($DBI::err)
              {&buildInput::reportDbError("fetching talk-to:",
                                      $DBI::errstr);}
# list of items in a single row
            my @tt;
# list of lists
            my @tt_list;
# reference to one list in tt_list
            my $ttref;
            while (@tt = $handle->fetchrow)
              { 
                if($DBI::err)
                  {
                    {&buildInput::reportDbError("fetching talk-to:",
                                                $DBI::errstr);}
                    return;
                  }
# push tt as a list onto the list stack (list of lists)
                push @tt_list, [@tt];
#                print OUT "tt item: @tt\n";
              }
            #  For each talk-to name get its talk-to menu and value
            foreach $ttref (@tt_list)
              {
                my $name;
                my $menu;
                my $value;
                my $ttinst;
                my $temp;
                ($name,$menu,$value,$ttinst) = @$ttref;
                my @submenu = split(/\//,$menu);
#  throw away the first (null) item
                shift @submenu;
                if ( @submenu > 0 ){
                  if ($submenu[0] =~ /\w/) 
                    {
                      foreach $temp (@submenu) {print OUT "    $temp\n";}
                      if (defined($value)) 
                        {
                          print OUT "      $name set $value\n";
                        }
                      foreach $temp (@submenu) {print OUT "    exit\n";}
                    }
                }
                else
                  {
                    if (defined($value)) 
                      {
                        print OUT "      $name set $value\n";
                      }
                  }
              }	  
            print "exit\n#\n";
          }
      }
  }

#---------------------------------------------------
sub doSQLinstances
 {
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
#
#    Get name of all instances in active paths
#
    my @List;
    my $ref_to_list = &doSQLgetPaths;
    @List = @$ref_to_list;
    my $path;
    my @pathandtag;
    my $instance;
    my @instance_list;
    foreach $path(@List)
    {

# the list from doSQLgetPaths returns a joined list of paths and 
# tags, so you need to split the path from the tag...

	@pathandtag = split /:/, $path; 
	
        my ($handle) = $main::dbh->prepare("select instance_name 
              from 
             l3_option_sequences, trigger_names, trigger_names_trigger_paths 
             where trigger_names_trigger_paths.path_name='$pathandtag[0]'and
              trigger_names_trigger_paths.path_tag='$pathandtag[1]' and 
           trigger_names_trigger_paths.trigger_name=trigger_names.trigger_name
           and trigger_names_trigger_paths.trigger_tag= 
                  trigger_names.trigger_tag and 
trigger_names.trigger_name=l3_option_sequences.trigger_name and 
trigger_names.trigger_tag=l3_option_sequences.trigger_tag and 
             trigger_names.trigger_level=3");
        if($DBI::err)
          {&buildInput::reportDbError("fetching instance:",
                                      $DBI::errstr);}
        $handle->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching instance:",
                                      $DBI::errstr);}
        while (my $instance = $handle->fetchrow)
          {
            if($DBI::err)
              {
                {&buildInput::reportDbError("fetching instance:",
                                            $DBI::errstr);}
                return;
              }

#	         print OUT "$instance\n";
            push @instance_list, $instance;
          }
  }
#
#  remove duplicate instance names
#
    @instance_list = sort @instance_list;
    my @unique_instance;
    my $last_instance = -1;
    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) = $main::dbh->prepare("select class_name from 
              l3_option_instances where instance_name='$instance'");
        if($DBI::err)
          {&buildInput::reportDbError("fetching class name:",
                                      $DBI::errstr);}
        $handle->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching class name:",
                                      $DBI::errstr);}
        if (defined(my $classname = $handle->fetchrow))
          { 
            $class_by_instance{$instance}=$classname;
          }
        if($DBI::err)
          {&buildInput::reportDbError("fetching class name:",
                                      $DBI::errstr);}
        #  Get names of talk-tos
        my ($handle1) = $main::dbh->prepare("select name,menu from 
                         l3_cut_and_parameters  
                         where instance_name='$instance'");
        if($DBI::err)
          {&buildInput::reportDbError("fetching talk-to name:",
                                      $DBI::errstr);}
        $handle1->execute();
        if($DBI::err)
          {&buildInput::reportDbError("fetching talk-to name:",
                                      $DBI::errstr);}
        my $name; my $menu;
        while (my @tt = $handle1->fetchrow)
          { 
            if($DBI::err)
              {
                {&buildInput::reportDbError("fetching talk-to name:",
                                            $DBI::errstr);}
                return;
              }
            ($name,$menu) = @tt;
# construct a talk-to unique identifier here
#  ... otherwise data structures get too nested
            my $identifier = "$name|$menu";
            push @tmpnames, $identifier;
            my ($handle) = $main::dbh->prepare("select value from 
                           l3_cut_and_parameters where 
                           instance_name='$instance' 
                           and name='$name' and menu='$menu'");
            if($DBI::err)
              {&buildInput::reportDbError("fetching talk-to value:",
                                          $DBI::errstr);}
            $handle->execute();
            if($DBI::err)
              {&buildInput::reportDbError("fetching talk-to value:",
                                          $DBI::errstr);}
            if (defined(my $value = $handle->fetchrow))
              {  
                if($DBI::err)
                  {
                    {&buildInput::reportDbError("fetching talk-to value:",
                                                $DBI::errstr);}
                    return;
                  }
                $value_by_instance_by_talkto{$instance}{$identifier} = $value;
#                print OUT "# getting talk-to $identifier for $instance which has value $value\n";
              }
            else
	    {                   
                $value_by_instance_by_talkto{$instance}{$identifier} = " ";
#                print OUT "# getting talk-to $identifier for $instance which has NO VALUE\n";
              }
          }
        # 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 )
	    {
#                print "#comparing $inst1 (class $class_by_instance{$inst1}) and $inst2 (class $class_by_instance{$inst2})\n";
                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 ( !defined($ttname) || !defined($inst2) )
                        {
                        if ( grep(/$ttname/,@{$talkto_by_instance{$inst2}}) )
                          {
                            if ($value_by_instance_by_talkto{$inst1}{$ttname} 
                                ne $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 "#  same value:";
#                                print " $value_by_instance_by_talkto{$inst1}{$ttname}, $value_by_instance_by_talkto{$inst2}{$ttname}\n";
                              }
#
#  a little experiment to understand how different checks work...
#
#                            if ($value_by_instance_by_talkto{$inst1}{$ttname} 
#                                ne $value_by_instance_by_talkto{$inst2}{$ttname})
#                              {print "passed first condition\n";}
#                            else
#                              {print "failed first condition\n";}
#                            if ($value_by_instance_by_talkto{$inst1}{$ttname} 
#                                != $value_by_instance_by_talkto{$inst2}{$ttname})
#                              {print "passed second condition\n";}
#                            else
#                              {print "failed second condition\n";}
                          }
                        else
                          {
                            $equiv = 0;
                          }
                      }
                      else
                        {
                          $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,\%class_by_instance);
 }

#---------------------------------------------------
  sub doSQLoutput  
{
    
    #  just do STDOUT for now
    open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
    
    # this returns a paired list of path stream pairs as
    #    path1,stream1,path2,stream2,etc.
    my $ref_paths_streams = &doSQLgetStreams;
    my @list_paths_streams = @$ref_paths_streams;
    # this will be a list of pairs (lists)
    my @list_of_path_stream_pairs;
    my $path_name;
    my $stream;
    my @stream_list;

    # form the list of pairs from the paired list; form also a stream list
    while ( $stream = pop @list_paths_streams )
      {
        $path_name = pop @list_paths_streams;
        push @list_of_path_stream_pairs, [ $path_name, $stream ];
        push @stream_list, $stream;
      }

#
# Remove duplicate stream names
#
    @stream_list = sort @stream_list;
    my @unique_stream;
    my $last_stream = "nada";
    my $new_stream;
    foreach $new_stream (@stream_list)
      {
        if ($new_stream ne $last_stream) 
          {
            push @unique_stream, $new_stream
          }
        $last_stream = $new_stream;
      }
    
# Loop over all unique datastreams
#
    foreach $new_stream (@unique_stream)
      {
        my $reduced_name = join("",split("STREAM",uc $new_stream)); 

# NONE is a special stream name... don't declare or reference this stream

        if ( $reduced_name ne "NONE")
          {
#
# here we need to check for legal stream name IF stream names have meaning
#
            if ( $main::stream_name_used == 1 )
              {
#               print STDERR "Str. Reduct.:$new_stream to $reduced_name\n";
                if ( $reduced_name lt "A" || $reduced_name gt "Z" 
                     || length($reduced_name) > 1 )
                  {
                    print STDERR "Stream Name $new_stream is illegal\n";
                    print OUT "#Stream Name $new_stream is illegal\n";
                    die;
                  }
              }
#
            print OUT "#\n";
            print OUT "output create $new_stream $new_stream.tmp\n";
############################
#
# new output keep/drop commands...  won't work before 4.8.4l3s or 4.10.0
#
	    print OUT "# output keep/drop... note this won't work before l3_4_8_4 Level3Mods tags or 4.10.x\n";
	    if ( ( $new_stream eq "StreamB" ) || 
		 ( $new_stream eq "StreamC" ) ||
		 ( $new_stream eq "StreamE" ) ||
		 ( $new_stream eq "StreamG" ) ||
		 ( $new_stream eq "StreamH" ) ||
		 ( $new_stream eq "StreamJ" ) )
              {
		print OUT "output processDropList $new_stream L3\n";
	      }
	    else 
	      {
		print OUT "output processKeepList $new_stream L3\n";
	      }
# calor recon
	    print OUT "output dropList $new_stream PhysicsTowerData CalData\n";
# B trigger monitoring
	    print OUT "output dropList $new_stream -add TransitoryL3_DV_Coll GrowFilterResultList\n";
# CT Track Hits
	    print OUT "output dropList $new_stream -add CT_HitSet CdfTrackHits:\"COT Hits for CdfTrack\"\n";
# Extra CT Tracking Collections (save only merged)
	    print OUT "output dropList $new_stream -add CdfTrackColl:COT_Global_Tracking_HL CdfTrackColl:COT_Global_Tracking_SL\n";
# Can be discarded
	    print OUT "output dropList $new_stream -add StorableRun2SiStripSet SiClusterSet\n";

# Definitely keep these :
	    print OUT "output keepList $new_stream LRIH_StorableBank Level3History Level3ModuleMap Level3ModuleResults L3SummaryObject\n";

# RAW data compression :
            print OUT "output keepList $new_stream -add *:PadRaw\n";
            print OUT "output dropList $new_stream -add *:temporary *:PadRaw_Bad\n";
	    
# RAW data dropping by stream :
	    if ( ( $new_stream eq "StreamB" ) || 
		 ( $new_stream eq "StreamC" ) ||
		 ( $new_stream eq "StreamE" ) ||
		 ( $new_stream eq "StreamG" ) ||
		 ( $new_stream eq "StreamH" ) ||
		 ( $new_stream eq "StreamJ" ) )
              {
		print OUT "output dropList $new_stream -add COTD_StorableBank SIXD_StorableBank ISLD_StorableBank\n";
		print OUT "output dropList $new_stream -add TMPD_StorableBank\n";
	      }
	    if (( $new_stream eq "StreamI" ) &&
		($main::phys_table=~/DROPRAW/) ) 
	      {
		print OUT "output dropList $new_stream -add COTD_StorableBank SIXD_StorableBank ISLD_StorableBank\n";
	      }
# RAW UNCOMPRESSED banks dropped for StreamA
	    if ( $new_stream eq "StreamA" )
	      {
		print OUT "output dropList $new_stream -add COTD_StorableBank SIXD_StorableBank ISLD_StorableBank\n";
	      }
#############################
#
# Loop over all paths
#
#
            print OUT "#\n output path $new_stream ";
            foreach my $ref_path_stream_pair ( @list_of_path_stream_pairs )
              {
                if ( $$ref_path_stream_pair[1] eq "$new_stream" ) 
                  {
                    my @pathandtag = split /:/, $$ref_path_stream_pair[0];
                    print OUT "$pathandtag[0]_v$pathandtag[1] ";
                  }
              }
            print OUT "\n";

#
# Dave Waters, 15 April 2003
# If StreamD exists, make this the error stream :
	    if ( $new_stream eq "StreamD")
	      {
		print OUT "errorStreamName set StreamD \n";
	      }
	    


          } # stream isn't "NONE"
      } # loop over streams
    print OUT "#\n";
}
#---------------------------

sub doSQLgetPaths  
 {
     open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
     
     #need the list of paths used with the physics table
     my @path_list;
#
# Getting the names of all associated data sets (used in this
# particular physics table)
#
     my ($handle) = $main::dbh->prepare("select dataset_name, 
                            dataset_tag from 
                            datasets_physics_tables where 
                            physics_table_name='$main::phys_table' and
                            physics_table_tag ='$main::phys_table_tag'");
     if($DBI::err)
       {&buildInput::reportDbError("fetching dataset:",
                                   $DBI::errstr);}
     $handle->execute();
     if($DBI::err)
       {&buildInput::reportDbError("fetching dataset:",
                                   $DBI::errstr);}
#
# print list of datasets on the fly     
#    print OUT "#list of datasets... ";
     my @set;
     while (@set = $handle->fetchrow)
     {
	 if($DBI::err)
	 {
       {&buildInput::reportDbError("fetching dataset:",
                                   $DBI::errstr);}
       return;
	 }
# dataset print
#    print OUT "$set[0]:$set[1] ";
#		
# Get the names of all associated trigger paths 
#
	 my ($handle) = $main::dbh->prepare("select path_name, path_tag from 
              datasets_trigger_paths where 
              datasets_trigger_paths.dataset_name='$set[0]' and 
              datasets_trigger_paths.dataset_tag='$set[1]'");
     if($DBI::err)
       {&buildInput::reportDbError("fetching path:",
                                   $DBI::errstr);}
	 $handle->execute();
     if($DBI::err)
       {&buildInput::reportDbError("fetching path:",
                                   $DBI::errstr);}
	 
	 my @path;
#dataset print
#     print OUT "(";
	 while (@path = $handle->fetchrow)
	 {
	     if($DBI::err)
	     {
           {&buildInput::reportDbError("fetching path:",
                                       $DBI::errstr);}
           return;
	     }
#
# Add the names of the path to a list that will contain all
# path names associated with this physics table
#

# Join the path name to the path tag so that they can be sorted for
# uniqueness
#dataset print
#     print OUT "$path[0]:$path[1],";
	     my $path_key = join ":", @path;
	     push @path_list, $path_key;
	 }
#dataset print
#     print OUT ") ";
	 
     }
# dataset print
#    print OUT "\n";
#
#  remove duplicate path names (stolen from doSQLoutput)
#
#    
    @path_list = sort @path_list;
    my @unique_path = ();
    my $last_path = -1;
    my $tpath;
#    print OUT "\n";
    foreach $tpath (@path_list)
    {
	if ($tpath ne $last_path) 
	{
	    push @unique_path, $tpath;
	}
	$last_path = $tpath;
    }
# Prints out list of paths    
#
#    print OUT "#list of paths... ";
#    foreach $tpath (@path_list)
#    {
#      print OUT "$tpath ";
#    }
#    print OUT "\n";

    return (\@unique_path);
     
 }

#---------------------------
sub doSQLgetStreams  
 {
     open (OUT, ">-") || die "I/O error accessing STDOUT:$!";
     
     #need the list of logger_datastreams used with the physics table
     my @list_paths_streams;
#
# Getting the names of all associated data sets (used in this
# particular physics table)
#
     my ($handle) = $main::dbh->prepare("select dataset_name, dataset_tag from 
                            datasets_physics_tables where 
                            physics_table_name='$main::phys_table' and
                            physics_table_tag ='$main::phys_table_tag'");
     if($DBI::err)
       {&buildInput::reportDbError("fetching datasets:",
                                   $DBI::errstr);}
     $handle->execute();
     if($DBI::err)
       {&buildInput::reportDbError("fetching datasets:",
                                   $DBI::errstr);}
 
     my @set;
     my @path_name;
     my $full_path_name;

     while (@set = $handle->fetchrow)
     {
	 if($DBI::err)
	 {
       {&buildInput::reportDbError("fetching datasets:",
                                   $DBI::errstr);}
       print "$DBI::errstr\n";
       return;
	 }
#		
# Get the names of all associated trigger paths for given datasets
#
	my ($handle) = $main::dbh->prepare("select path_name, path_tag from 
                            datasets_trigger_paths where 
                            dataset_name='$set[0]' and
                            dataset_tag='$set[1]'");
     if($DBI::err)
       {&buildInput::reportDbError("fetching paths:",
                                   $DBI::errstr);}
	 $handle->execute();
     if($DBI::err)
       {&buildInput::reportDbError("fetching paths:",
                                   $DBI::errstr);}
	 
	 while (@path_name = $handle->fetchrow)
	 {
	     if($DBI::err)
	     {
           {&buildInput::reportDbError("fetching paths:",
                                       $DBI::errstr);}
           return;
	     }
#	     print OUT "Trigger_path is $path_name[0]\n";
#	     print OUT "Trigger_tag is $path_name[1]\n";
	     $full_path_name = join ":", @path_name;
#	     print OUT "Path_name is $full_path_name\n";
#
# Add the name of the logger datastream to the trigger path
#
	     my ($handle) = $main::dbh->prepare("select logger_datastream from 
                            datasets, datasets_trigger_paths where 
                            datasets.dataset_name='$set[0]' and
                            datasets.dataset_tag='$set[1]' and 
                            datasets.dataset_name=datasets_trigger_paths.dataset_name and
                            datasets.dataset_tag=datasets_trigger_paths.dataset_tag and 
                            datasets_trigger_paths.path_name='$path_name[0]' and 
                            datasets_trigger_paths.path_tag='$path_name[1]'");
         if($DBI::err)
           {&buildInput::reportDbError("fetching logger_datastream:",
                                       $DBI::errstr);}
	     $handle->execute();
         if($DBI::err)
          {&buildInput::reportDbError("fetching logger_datastream:",
                                      $DBI::errstr);}
	     
	     my $datastream;
	     while ($datastream = $handle->fetchrow)
	     {
		 if($DBI::err)
		 {
		     reportDbError("fetching logger_datastream:",$DBI::errstr);
		     return;
		 }
#		 print OUT "#Logger datastream is $datastream\n";
		 push @list_paths_streams, ($full_path_name,$datastream);
	     }
	 }

     }

#     print OUT "The list of paths and streams is @list_paths_streams\n";
	 
     return (\@list_paths_streams);
     
 }


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

sub reportDbError 
  {
    print STDOUT "#DATABASE ERROR...";
    foreach my $message (@_) {
      print STDOUT "$message";
      print STDERR "$message";
    }
    print STDOUT "\n";
    print STDERR "\n";
  }