=head1 NAME

  CFX5::Simulation::Configuration::Debug - Debugging code for CFX5::Simulation::Configuration

=head1 SYNOPSIS

  require CFX5::Simulation::Configuration::Debug;
  $self->CFX5::Simulation::Configuration::Debug::dummy_solver(@_);

=head1 DESCRIPTION

This library is used by the CFX5::Simulation::Configuration object if debugging is turned
on, and provides routines for handling debugging and testing
harnesses.

Because it is brought in at runtime, any routines in here will not be
callable from the distributed code on Windows NT.  Caveat Fabricator.

$Id$

=cut

package CFX5::Simulation::Configuration::Debug;

use strict;
use CFX5::Output qw(:all error_text);

use CFX5::PathManip qw(dirname basename fullpath join_file abspath);

use CFX5::Config qw(setconf %Config export_conf getconf_default getconf
                    append_to_libpath);

use CFX5::DefFile;
use CFX5::Files::Partition;

use CFX5::CmdLine qw(parse_cmdline);
use CFX5::FileOps qw(append_to_file copy_file);

use CFX5::Commands qw(parse_rv);

use Carp;

use base 'CFX5::Output::CCL';

=head2 CONSTRUCTORS

=head3 new

  # from a CFX-5 Job object
  my $dbg=$job->debug_obj();

  # it should not usually be created directly
  my $dbg=CFX5::Simulation::Configuration::Debug->new($job);

Instantiates a new debug object for the supplied job object.  Note
that the debug objects follow the singleton pattern - if this call is
made multiple times, it will always return the same object.

=cut

{
  my $TheInstance;
sub new {
  my $this=shift;
  my $class=ref($this) || $this;
  unless (defined $TheInstance) {
    $TheInstance={ job => $_[0] };
    bless $TheInstance, $class;
  }
  $TheInstance;
}
}

=head2 LOW-LEVEL FILE WRITING

=head3 job

Returns the job object associated with this object.

=cut

sub job { $_[0]->{job}; }

=head3 filename

  my $fn=$dbg->filename();

Returns the file basename to use.  Currently it will always be called
"cfx5-job.log" in the start directory, but in the future it may change
to reflect the run name.

=cut

sub filename {
  my $self=shift;
  if (defined $self->{filename}) {
    return $self->{filename};
  }

  $self->{filename}=fullpath('cfx5solve.tjob');
  #$self->{filename}=$self->job()->fullname().'.tjob';
  # we've just defined it, so empty it and write to it now
  local *FILE;
  open FILE, ">$self->{filename}" and close FILE;
  $self->log("# job file from solver job object");
  $self->log("# run started", scalar(localtime));
  return $self->{filename};
}

=head3 log

  $dbg->log('run solver', $exec, @args);

This function writes a line to the job file.  The options written are
arbitary, but should remain the same most of the time.  They are
subject to some mangling since this file is designed for use in
regression testing:

=over

=item CFX5ROOT

Any occurrence of the CFX-5 root directory is replaced with the string
C<$CFX5ROOT>. 

=item CFX5OS

Any occurrence of the CFX-5 OS string for the current host is replaced
with the string C<$CFX5OS>.

=item CFXBUILDID

Any occurrence of the CFX-5 release number is replaced with the string
C<$CFXBUILDID>.

=item backslashes

All backslashes are replaced by forward slashes.

=back

If the first character is a hash mark, the line will be treated as a
comment by the regression tests.  If it is a percentage sign, it
denotes a line which is not for direct comparison, but is used by
other parts of the regression testing infrastructure.

=cut

{
  my ($TestRoot,$TestRootWin,$TestRootWinFW,$TestRootSht,$TestRootShtFW);
sub log {
  my $self=shift;

  my @args=@_;
  for my $a (@args) {
    if (defined $a) {
      # if we're running from within a regression test, see what we
      # can do with the test root information.  Do this before looking
      # at the CFX-5 root directory in case this is a central test!
      if (exists $ENV{CFX_TEST_ROOT} and not defined $TestRoot) {
        # UNIX-style
        $TestRoot=$ENV{CFX_TEST_ROOT};
        # on NT, check for various Windows styles - abspath will use
        # cygpath if we have it
        $TestRootWin=abspath($TestRoot);
        # Windows short path
        undef $TestRootSht;
        undef $TestRootShtFW;
        if ($Config{windows_nt}) {
          require Win32;
          $TestRootSht = Win32::GetShortPathName($TestRootWin);
          ($TestRootShtFW=$TestRootSht) =~ s!\\!/!g;
        }

        if ($TestRootWin ne $TestRoot) {
          ($TestRootWinFW=$TestRootWin) =~ s!\\!/!g;
        } else {
          # if it's the same as the test root (eg, on UNIX!), we don't
          # need to do anything more
          undef $TestRootWin;
        }
      }

      # Substitute any style of test root with the string '$TEST_ROOT'
      for my $root ($TestRoot,
                    $TestRootWin,
                    $TestRootWinFW,
                    $TestRootSht,
                    $TestRootShtFW) {
        $a =~ s!\Q$root!\$CFX_TEST_ROOT!g if defined $root;
      }

      (my $rootfw=$Config{CFX5ROOT}) =~ s!\\!/!g;

      # various other variables we can subst.  Order here is
      # important, eg the host "tlinux".
      $a =~ s!\Q$Config{CFX5ROOT}!\$CFX5ROOT!g;
      $a =~ s!\Q$rootfw!\$CFX5ROOT!g;
      $a =~ s!\Q$Config{CFXBUILDID_MAJOR_MINOR}!\$CFXBUILDID_MAJOR_MINOR!g;
      $a =~ s!\Q$Config{CFX_FULLHOST}!\$CFX_HOST!g;
      $a =~ s!\Q$Config{CFX_HOST}!\$CFX_HOST!ig;
      $a =~ s!\Q$Config{CFX5OS}!\$CFX5OS!g;

      # finally, any remaining paths we make forward-slashed
      $a =~ s!\\!/!g;
    } else {
      $a = '(undef)';
    }
  }

  local *FILE;
  if (open FILE, ">>".$self->filename()) {
    print FILE join(" ",@args),"\n";
    close FILE;
  }
  print join(" ",@args),"\n" if $Config{CFX5_TEST_INTERACTIVE};
}
}

=head2 CCL LOGGING

This section provides call(s) to write CCL to debug logs; this is to
get around the problems of ordering of keys and so on which affect
(harmlessly) the standard CCL parser, so we can use grep to compare
them.

=head3 log_ccl

  $dbg->log_ccl($cclapiobj, $path);

=cut

sub log_ccl {
  my $self=shift;
  my $api=shift;
  my $path=shift || '/';

  my $rinfo;
  $api->getChildInfoList($path, \$rinfo);
  #use Data::Dumper; print Dumper($rinfo);
  my %info=map { $_->{name} => $_ } @$rinfo;
  my @names=sort keys %info;
  for my $n (@names) {
    my $npath=$path eq '/' ? "/$n" : "$path/$n";
    # skip all library objects
    next if $npath eq '/RULES';
    next if $api->isLibrary($npath);
    if ($info{$n}->{className} eq 'Object') {
      # recursive call
      $self->log('ccl-object', $npath, $info{$n}->{type});
      $self->log_ccl($api, $npath);
    } elsif ($info{$n}->{className} eq 'Singleton') {
      # recursive call
      $self->log('ccl-singleton', $npath);
      $self->log_ccl($api, $npath);
    } else {
      # endcase
      my $val;
      $api->getStringValue($npath,\$val);
      $self->log('ccl-param', $npath, '=', $val);
    }
  }
}

=head2 DUMMY EXECUTABLES

These are called by the "pretendable executables" in CFX5::Simulation::Configuration, and
try to emulate (at a low level) the behaviour of the standard
components.

=head3 dummy_solver

=cut

sub dummy_solver {
  my $job=shift;
  my @args=@_;
  my $dbg=$job->debug_obj();

  $dbg->log('solver-args',@args);

  # first arg is executable
  shift @args;

  # OK, what args to we have?
  my ($part,$par,$size,$outopt,$nojob,@miscopt);
  $size='(unspecified)';
  parse_cmdline(\@args,
		'-outopt+' => \$outopt,
		'-part?' => sub { $part = defined $_[1] ? $_[1] : -1; },
		'-par' => \$par,
		'-s+' => \$size,
		'-nojob' => \@miscopt,
		'-ni+' => sub { push @miscopt, $_[0 .. 1] },
		'-nr+' => sub { push @miscopt, $_[0 .. 1] },
		'-nl+' => sub { push @miscopt, $_[0 .. 1] },
		'-nc+' => sub { push @miscopt, $_[0 .. 1] },
		'-nd+' => sub { push @miscopt, $_[0 .. 1] },
	       );

  # (TODO: because this is debugging code, we don't worry about the
  # CFX5::Output::File stuff.  We should.)
  my $outfile=$Config{CFX_SOLVER_OUTPUT_FILE} || 'out';
  if (!$outopt) {
    $dbg->log('have-outopt');
    append_to_file($outfile, "(verbose output here)\n");
  }
  if ($part) {
    # write to out file
    append_to_file($outfile, "Partitioning run, $part partitions\n");
    append_to_file($outfile, "Memory factor is $size\n");
    $dbg->log('do-partition',$part,$size,@miscopt);
    # write to par file
    my $par=CFX5::DefFile->new_file('par');
    my $ds=$par->new_dataset();
    $ds->header(-what => 'G/NOTE');
    $ds->header(-where => 'EVERY');
    $ds->header(-when => 0);
    $ds->data_text("Partition file from dummy run");
    $par->write_dataset($ds);
  } elsif ($par) {
    # write to out file
    append_to_file($outfile, "Parallel run\n");
    append_to_file($outfile, "Memory factor is $size\n");
    $dbg->log('do-parallel',$size,@miscopt);
    # write to res file
    copy_file(def => 'res');
    my $par=CFX5::DefFile->new('res');
    my $ds=$par->new_dataset();
    $ds->header(-what => 'G/NOTE');
    $ds->header(-where => 'EVERY');
    $ds->header(-when => 0);
    $ds->data_text("Results file from dummy parallel run");
    $par->write_dataset($ds);
  } else {
    # write to out file
    append_to_file($outfile, "Standard serial run\n");
    append_to_file($outfile, "Memory factor is $size\n");
    $dbg->log('do-serial',$size,@miscopt);
    # write to res file
    copy_file(def => 'res');
    my $par=CFX5::DefFile->new('res');
    my $ds=$par->new_dataset();
    $ds->header(-what => 'G/NOTE');
    $ds->header(-where => 'EVERY');
    $ds->header(-when => 0);
    $ds->data_text("Results file from dummy serial run");
    $par->write_dataset($ds);
  }

  if (@miscopt) {
    append_to_file($outfile, "Also including the following args: ", 
		   join(" ",@miscopt), "\n");
  }

  # give some output we can check for
  {
    my $out=$job.' '.rand();
    append_to_file($outfile, "This is some output from the solver:\n  $out\nHonest.\n");
    $dbg->log('%output-file-check', $out);
  }

  # write a monitor point file
  my @monhdr=<<'EOT';
@START@
CURRENT TIMESTEP
ACCUMULATED TIMESTEP
RESIDUAL,RMS,StaticMixer,U-Mom
RESIDUAL,MAX,StaticMixer,U-Mom
RESIDUAL,RMS,StaticMixer,V-Mom
RESIDUAL,MAX,StaticMixer,V-Mom
RESIDUAL,RMS,StaticMixer,W-Mom
RESIDUAL,MAX,StaticMixer,W-Mom
RESIDUAL,RMS,StaticMixer,P-Mass
RESIDUAL,MAX,StaticMixer,P-Mass
RESIDUAL,RMS,StaticMixer,H-Energy
RESIDUAL,MAX,StaticMixer,H-Energy
FLOW,in1,U-Mom
FLOW,in2,U-Mom
FLOW,out,U-Mom
FLOW,Default,U-Mom
SOURCE,StaticMixer,U-Mom
FLOW,in1,V-Mom
FLOW,in2,V-Mom
FLOW,out,V-Mom
FLOW,Default,V-Mom
SOURCE,StaticMixer,V-Mom
FLOW,in1,W-Mom
FLOW,in2,W-Mom
FLOW,out,W-Mom
FLOW,Default,W-Mom
SOURCE,StaticMixer,W-Mom
FLOW,in1,P-Mass
FLOW,in2,P-Mass
FLOW,out,P-Mass
FLOW,Default,P-Mass
SOURCE,StaticMixer,P-Mass
FLOW,in1,H-Energy
FLOW,in2,H-Energy
FLOW,out,H-Energy
FLOW,Default,H-Energy
SOURCE,StaticMixer,H-Energy
BALANCE,StaticMixer,U-Mom
BALANCE,StaticMixer,V-Mom
BALANCE,StaticMixer,W-Mom
BALANCE,StaticMixer,P-Mass
BALANCE,StaticMixer,H-Energy
FORCE,NORMAL,Default,X-DIR
FORCE,NORMAL,Default,Y-DIR
FORCE,NORMAL,Default,Z-DIR
FORCE,TANGENTIAL,Default,X-DIR
FORCE,TANGENTIAL,Default,Y-DIR
FORCE,TANGENTIAL,Default,Z-DIR
@END@
EOT

  my @mondata=<<'EOT';
1,1,0.000000e+000,0.000000e+000,2.845652e-005,7.095146e-004,0.000000e+000,0.000000e+000,1.525165e-003,2.379151e-002,3.484351e-003,4.745988e-002,0.000000e+000,0.000000e+000,0.000000e+000,0.000000e+000,0.000000e+000,1.448005e-002,-1.376238e-002,0.000000e+000,0.000000e+000,0.000000e+000,0.000000e+000,0.000000e+000,0.000000e+000,0.000000e+000,0.000000e+000,1.413334e+003,1.411382e+003,-1.987092e+003,0.000000e+000,0.000000e+000,1.865389e+009,1.685402e+009,-2.497862e+009,0.000000e+000,0.000000e+000,0.000000e+000,4.956284e-002,0.000000e+000,4.215324e-001,4.215321e-001,1.812500e+000,9.784375e+001,7.080769e+004,0.000000e+000,0.000000e+000,0.000000e+000
2,2,5.206347e-003,5.762973e-002,2.594369e-002,2.669319e-001,2.353928e-002,4.425634e-001,8.773363e-003,1.680013e-001,1.105366e-003,9.157532e-003,-1.453883e+000,1.577533e+000,6.607472e+001,4.904366e+001,0.000000e+000,4.202085e+003,-4.166176e+003,-5.546406e+001,4.217644e+000,0.000000e+000,-3.806629e-001,-1.031605e+000,3.448918e+003,-1.597497e+003,0.000000e+000,1.413334e+003,1.411382e+003,-2.470306e+003,0.000000e+000,0.000000e+000,1.865389e+009,1.685402e+009,-3.105360e+009,0.000000e+000,0.000000e+000,9.060554e-003,-1.205844e-003,1.454513e-001,1.434681e-001,1.434393e-001,-4.956250e+001,9.362500e+001,7.240641e+004,-2.377706e-001,-2.413758e-001,-1.869152e-001
3,3,2.455048e-003,2.079841e-002,1.291019e-002,1.086700e-001,5.106619e-003,5.566069e-002,4.614538e-003,4.459288e-002,1.107503e-003,5.230248e-003,-4.458594e-002,9.035046e-001,-4.533460e+001,1.074958e+002,0.000000e+000,1.165942e+004,-1.146104e+004,1.374920e+002,-2.002222e+002,0.000000e+000,-8.943570e-001,-9.321407e-001,7.755400e+003,-9.499625e+003,0.000000e+000,1.413334e+003,1.411382e+003,-2.707779e+003,0.000000e+000,0.000000e+000,1.865389e+009,1.685402e+009,-3.404323e+009,0.000000e+000,0.000000e+000,5.278168e-004,1.136142e-003,-1.462384e-002,4.318567e-002,4.302407e-002,-1.075000e+002,2.974375e+002,8.033788e+004,-3.296766e+001,-3.309077e+001,-2.716982e+001
EOT

  append_to_file('mon',@monhdr);
  unless ($part) {
    append_to_file('mon',@mondata);
  }

  return parse_rv(0);			# success!
}

1;
