=head1 NAME

CFX5::Output::CCL - output routines for a solver-style out file

=head1 SYNOPSIS

  use CFX5::Output;

=head1 DESCRIPTION

The C<CFX5::Output::CCL> class implements copying of errors to a
file, formatting them in a manner compatible with the output from the
ANSYS CFX solver.  It is based on the C<CFX5::Output::File> class.

=cut

package CFX5::Output::CCL;
@ISA=qw(CFX5::Output::File);
use strict;

use CFX5::Output::File;

use CFX5::Output qw(:all);
use CFX5::Output::Utils qw(wraptext);

=head2 STANDARD METHODS

=head3 init

The C<init> routine here should be passed a filehandle, which it
stores locally and

=cut

sub init {
  my $self=shift;

  $self->SUPER::init(@_);

  1;
}

=head3 output

This version of the C<output> function uses the on/off settings from
C<set_verbosity> to decide whether to output a given message or not.

=cut

sub output {
  my $self=shift;
  my $type=shift;
  my $severity=shift;
  my $title=shift;
  my $text=join('',@_);

  $self->internal_error("Unknown output type $type") 
    unless exists $self->{settings}{$type};
  
  return unless $self->{settings}{$type};

  if (my $fh=$self->open()) {
    print $fh ($self->text_to_ccl($title,$severity,$text));
    $self->close();
  }

  return 1;
}

=head3 gui_objname

By default, the GUI INFORMATION object is a CCL singleton.  This call
can be used to name it, for callers who need this.  Invalid CCL
characters will be replaced by spaces.

=cut

sub gui_objname {
  my $self=shift;
  if (@_) {
    ($self->{objname}=shift) =~ s![^0-9A-Za-z. -]! !g;
  }
  $self->{objname};
}

=head3 text_to_ccl

This is similar to the C<text_to_show> call in L<CFX5::Output::Base>,
but takes different arguments.  It is responsible for rendering the
output into CCL.

=cut

my $ErrorNumber=1;
sub text_to_ccl {
  my $self=shift;
  my $title=shift;
  my $severity=shift;
  my $text=join('',@_);

  my $width=$self->wrapwidth();

  my @out='GUI INFORMATION:';
  if (defined $self->gui_objname()) {
    push @out, "RUN MESSAGES: ".$self->gui_objname();
  }
  push @out, "  DISPLAY MESSAGE: m$ErrorNumber";
  $ErrorNumber++;

  push @out, "    Title = $title" if defined $title;
  push @out, "    Level = ".uc($severity) if defined $severity;

  #$text .= "\n\n" . $self->stack_trace() if $self->{settings}{stack};

  # for now, we replace " with ' to keep the parsing simple
  $text =~ s!\"!\'!g;
  # split text into lines
  my @text=split("\n", wraptext(-($self->wrapwidth()), $text));
  # and make a quoted string list of them
  push @out, "    Message = ". join(', ', map { qq{"$_"} } @text);

  push @out, "  END", "END";
  if (defined $self->gui_objname()) {
    push @out, 'END';
  }

  return join("\n",@out,"");
}

=head3 print_msg

Prints a set of arbitary CCL parameters in a message packet (ie,
putting them into the expected place in the CCL hierarchy).

=cut

sub print_msg {
  my $self=shift;
  my @out=('GUI INFORMATION:', "  DISPLAY MESSAGE: m$ErrorNumber");
  $ErrorNumber++;

  push @out, map { "    $_" } @_;

  push @out, '  END','END';

  if (my $fh=$self->open()) {
    print $fh (join("\n",@out,''));
    $self->close();
  }

  1;
}

=head2 UTILITY ROUTINES

=head3 stdout_ccl_comms

  CFX5::Output::CCL::stdout_ccl_comms();

This routine is used to set up the standard output file descriptor as
a communications channel using CCL error messages.  It does the
following:

=over

=item *

Saves the current stdout descriptor, and then reopens stdout to the
same stream as stderr (in case the script uses it in the future).

=item *

Creates a new output object to mirror any error messages to CCL in the
output stream.

=back

=cut

my $StdoutCCLCommObj;
use Symbol;

sub stdout_ccl_comms {
  if (defined $StdoutCCLCommObj) {
    # already been called!
    return 1;
  }

  _trace("Setting up comms channel on stdout");

  my $cclfh=gensym;
  unless (open $cclfh, ">&STDOUT") {
    _abort("Error starting communications channel: unable to duplicate stdout: $!");
  }
  unless (open STDOUT, ">&STDERR") {
    _abort("Error starting communications channel: unable to duplicate stderr: $!");
  }

  # unbuffer everything
  select((select(STDOUT), $| = 1)[0]);
  select((select(STDERR), $| = 1)[0]);
  select((select($cclfh), $| = 1)[0]);

  $StdoutCCLCommObj=__PACKAGE__->new($cclfh);
  my $rv=add_output_object($StdoutCCLCommObj);

  # and finally, send something over it so the other end knows it's
  # there
  print $cclfh "GUI INFORMATION:\nEND\n";

  $rv;
}

=head3 close_ccl_comms

  CFX5::Output::CCL::close_ccl_comms();

If the C<stdout_ccl_comms> call above has been made, this will shut
down the communications channel held open on stdout.  This means that
it closes the file descriptor, and removes the object from the output
object stack.

=cut

sub close_ccl_comms {
  unless (defined $StdoutCCLCommObj and $StdoutCCLCommObj) {
    # no channel!
    return 0;
  }

  remove_output_object($StdoutCCLCommObj);

  # the open should return our filehandle, so we don't need to close
  # it with the object call.
  my $cclfh=$StdoutCCLCommObj->open();
  unless (close $cclfh) {
    _abort("Unable to close communications channel: $!");
  }

  # make sure we don't go through all this again!
  $StdoutCCLCommObj='';

  1;
}

=head3 get_ccl_comms

  my $outobj=CFX5::Output::CCL::get_ccl_comms();

Returns the object we are using for the comms channel.

=cut

sub get_ccl_comms {
  return $StdoutCCLCommObj;
}


my $FileCCLCommObj;
use Symbol;

sub ccl_file_comms {
  if (defined $FileCCLCommObj) {
    # already been called!
    return 1;
  }

  my ($file) = @_;

  if ( !defined( $file ) ) { return 1; }

  _trace("Setting up comms channel on for file $file");

  my $cclfh=gensym;
  unless (open $cclfh, ">$file") {
    _abort("Error starting communications channel: unable to open $file: $!");
  }

  select((select($cclfh), $| = 1)[0]);

  $FileCCLCommObj=__PACKAGE__->new($cclfh);
  my $rv=add_output_object($FileCCLCommObj);

  $rv;
}

=head3 close_ccl_file_comms

  CFX5::Output::CCL::close_ccl_file_comms();

If the C<stdout_ccl_comms> call above has been made, this will shut
down the communications channel held open on stdout.  This means that
it closes the file descriptor, and removes the object from the output
object stack.

=cut

sub close_ccl_file_comms {
  unless (defined $FileCCLCommObj and $FileCCLCommObj) {
    # no channel!
    return 0;
  }

  remove_output_object($FileCCLCommObj);

  # the open should return our filehandle, so we don't need to close
  # it with the object call.
  my $cclfh=$FileCCLCommObj->open();
  unless (close $cclfh) {
    _abort("Unable to close communications channel: $!");
  }

  # make sure we don't go through all this again!
  $FileCCLCommObj='';

  1;
}

=head3 get_ccl_file_comms

  my $outobj=CFX5::Output::CCL::get_ccl_file_comms();

Returns the object we are using for the comms channel.

=cut

sub get_ccl_file_comms {
  return $FileCCLCommObj;
}

1;
