=head1 NAME

CFX5::Output::File - output routines for a file

=head1 SYNOPSIS

  use CFX5::Output;

=head1 DESCRIPTION

The C<CFX5::Output::File> class implements copying of errors to a
file.  The file is not kept open, but is opened and closed when
necessary, allowing other processes to write to it between errors.

This is designed for use in L<CFX5::Job> to copy error messages to the
output file, but other uses are possible!  The file is only opened
when needed to write a message to it, and is closed again as soon as
possible after that.

B<BIG FAT WARNING> about writing to this file from other parts of the
Perl script: do I<not> simply C<open>/C<write>/C<close> a file
registered with this object from other parts of Perl!  Perl does not
handle two filehandles pointing at the same file, and will try to
write both sets of data into the same place, leading to loss of data
(the exact form of which depends on the order of closing the
filehandles, among other things).  Instead, this object provides
C<open> and C<close> methods, which you should always use.

=cut

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

use CFX5::Output::Base;

use CFX5::Output qw(:all);

=head2 STANDARD METHODS

=head3 init

The C<init> routine here reads the C<CFX_OUTPUT> environment variable,
and uses it to set up the list of output types to process or ignore.
It also expects to be passed a filename, which is the output file to
use.

If it is passed a (glob) reference, it is assumed to be an
already-open filehandle, and that will be used instead for all IO:
open and close will become null ops.

=cut

sub init {
  my $self=shift;
  my $filename=shift;

  return 0 unless defined $filename;
  $self->{filename}=$filename;

  unless (exists $self->{settings}) {
    # The default on/off settings
    #    1 => display
    #    0 => do not display
    $self->{settings}=
      {
       'internal' => 1,
       'abort'    => 1,
       'error'    => 1,
       'warn'     => 1,
       'info'     => 0,
       'moreinfo' => 0,
       'trace'    => 0,
       'debug'    => 0,
       'stack'    => 0,
       'print'    => 1,
      };
  }

  unless (exists $self->{handle}) {
    $self->{handle} = 
      {
       handle => undef,
       count  => 0,
      };
  }

  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_show($title,$text));
    $self->close();
  } else {
    _error("Unable to copy error into", $self->{filename});
  }

  return 1;
}

=head2 CUSTOM METHODS

The C<open> and C<close> functions here are used to acquire and
release a filehandle for the file.  B<You must> use these routines for
B<any> access to the file registered with this object; see the
comments in the introduction for more details.

=head3 open

  my $fh=$outobj->open();

Returns a filehandle which can be used to write to the file.  Each
call to C<open> must be paired with a matching call to C<close>; the
file will be kept open, and the same filehandle returned by further
C<open>s, until all outstanding copies are closed, when the file will
be closed again.

Note that the matching C<close> must be explicit; the following code
will never close the filehandle:

  {
    my $fh=$outfile->open();
    print $fh "Testing ...\n";
    # $fh goes out of scope without being closed
  }

Because of this, a warning will be printed if the object is destroyed
but still believes that there is a handle open.

If the file cannot be opened, the return value is C<undef>.

=cut

use Symbol;
sub open {
  my $self=shift;

  if (ref $self->{filename}) {
    # assume it's a globref and return it as a filehandle ...
    return $self->{filename};
  }

  if ($self->{handle}{count}++) {
    # already got one
    return $self->{handle}{handle};
  }
 
  # nope, need to open the file.
  my $fh=gensym;
  unless (open $fh, ">>".$self->{filename}) {
    $self->{handle}{count}--;
    return undef;
  }
  $self->{handle}{handle}=$fh;

  # unbuffer it (see perlfaq5)
  select((select($fh), $| = 1)[0]);

  $fh;
}

=head3 close

  $outobj->close();

Registers the fact that a piece of code has finished with the file;
only if C<close> has been called as many times as C<open> is the file
actually closed!  This means that, if you know you are writing errors
to a file and want to print many lines which will be copied to the
file, you can do something like the following, which relies on the
fact that this module uses C<open> and C<close> internally as well:

  $outobj->open() or die; # don't need the filehandle in this case
  for my $msg (@_) {
    _print "> $msg\n";
  }
  $outobj->close() or die; # the file will be closed here

The return value is the return value from the Perl C<close> call, or
TRUE if the file is kept open for other users.

=cut

sub close {
  my $self=shift;

  if (ref $self->{filename}) {
    # assume it's a globref, and do nothing
    return 1;
  }

  if (--$self->{handle}{count}) {
    return 1;
  }

  # we are the last one
  my $fh=$self->{handle}{handle};
  $self->{handle}{handle}=undef;

  return close($fh);
}

sub DESTROY {
  my $self=shift;
  if ($self->{handle}{count}) {
    _warn("Unclosed handles in CFX5::IO::File object for", $self->{filename});
  }
  while ($self->{handle}{count}) {
    $self->close();		# decrements the member variable
  }
  1;
}

1;
