# Render.pm: Class Used to Render Reports at Collection Time

package RDA::Handle::Render;

# $Id: Render.pm,v 1.8 2014/10/13 16:18:57 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Handle/Render.pm,v 1.8 2014/10/13 16:18:57 RDA Exp $
#
# Change History
# 20141013  MSC  Use the T_LOCAL property to launch RDA.

=head1 NAME

RDA::Handle::Render - Class Used to Render Reports at Collection Time

=head1 SYNOPSIS

 require RDA::Handle::Render;

=head1 DESCRIPTION

The objects of the C<RDA::Handle::Render> class are used to render reports
while they are generated.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Object::Rda qw($CREATE $FIL_PERMS);
  use Symbol;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Define the global private constants

# Define the global private variables

# Report the package version
sub Version
{ return $VERSION;
}

=head2 S<$h = Rda::Handle::Render-E<gt>new($out[,$rul])>

The object constructor. It takes the reporting control reference and the
immediate rendering rules as arguments.

C<Rda::Handle::Render> is represented by a blessed hash reference. The
following special keys are used:

=over 12

=item S<    B<'_agt'> > Reference to the agent object

=item S<    B<'_cfg'> > Reference to the RDA software configuration

=item S<    B<'_ofh'> > Rendering output file handle

=item S<    B<'_out'> > Reference to the output control object

=item S<    B<'_rnd'> > Immediate rendering hash

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $out, $rul) = @_;
  my ($agt, $cfg, $ofh, $slf);

  # Create the render object
  $agt = $out->get_info('agt');
  $cfg = $agt->get_config;
  $slf = bless {
    _agt => $agt,
    _cfg => $cfg,
    _out => $out,
    }, ref($cls) || $cls;

  # Control immediate rendering
  if ($rul)
  { # Create the rendering handle
    $slf->{'_ofh'} = $ofh = bless Symbol::gensym(), ref($slf);
    tie *$ofh, $ofh;  ## no critic (Tie)
    *$ofh->{'fil'} = 0;
    *$ofh->{'pip'} = IO::File->new;
    *$ofh->{'rpt'} = IO::File->new;
    *$ofh->{'sep'} = 0;

    # Get the report list
    foreach my $val (split(/[\:\;]/, $rul))
    { $slf->{'_rnd'}->{uc($1)} = qr{$2}i
        if $val =~ m{^([A-Z][A-Z\d]*_[A-Z][A-Z\d]*_)(.*$)};
    }

    # Launch the rendering subprocess
    $ofh = *$ofh->{'pip'};
    open($ofh, join(q{ }, q{|}, $cfg->get_value('T_LOCAL'),  ## no critic (Open)
      '-XRda', '-s'.$cfg->quote($cfg->get_file('D_CWD', $agt->get_oid)),
      'render', '-o')) or
      die get_string('ERR_LAUNCH', $!);
    $ofh->autoflush(1);
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>end>

This method ends any rendering activity.

=cut

sub end
{ my ($slf) = @_;

  if (exists($slf->{'_ofh'}))
  { my $pip = $slf->{'_ofh'};

    *$pip->{'rpt'}->close if *$pip->{'fil'};
    *$pip->{'pip'}->close;
    delete *$pip->{'fil'};
    delete *$pip->{'pip'};
    delete *$pip->{'rpt'};
    delete *$pip->{'sep'};
    undef *$pip;

    delete $slf->{'_ofh'};
    delete $slf->{'_rnd'};
  }
  return 1;
}

=head2 S<$h-E<gt>get_handle($abr,$nam)>

This method returns the rendering pipe handle if the report must be rendered
immediately. Otherwise, it returns an undefined value.

=cut

sub get_handle
{ my ($slf, $abr, $nam) = @_;

  return (exists($slf->{'_ofh'})
    && exists($slf->{'_rnd'}->{$abr})
    && $nam =~ $slf->{'_rnd'}->{$abr}) ? $slf->{'_ofh'} : undef;
}

# --- Functions to emulate a file handle --------------------------------------

sub _not_implemented
{ return;
}

*blocking = \&_not_implemented;
*clearerr = \&_not_implemented;
*eof = \&_not_implemented;
*error = \&_not_implemented;
*fileno = \&_not_implemented;
*getc = \&_not_implemented;
*getline = \&_not_implemented;
*getlines = \&_not_implemented;
*getpos = \&_not_implemented;
*input_line_number = \&_not_implemented;
*opened = \&_not_implemented;
*printflush = \&_not_implemented;
*read = \&_not_implemented;
*seek = \&_not_implemented;
*setpos = \&_not_implemented;
*stat = \&_not_implemented;
*sync = \&_not_implemented;
*sysread = \&_not_implemented;
*sysseek = \&_not_implemented;
*syswrite = \&write;
*tell = \&_not_implemented;
*truncate = \&_not_implemented;
*ungetc = \&_not_implemented;
*untaint = \&_not_implemented;

sub autoflush
{ my $slf = shift;

  return *$slf->{'rpt'}->autoflush(@_) if *$slf->{'fil'};
  return;
}

sub close  ## no critic (Ambiguous,Builtin)
{ my $slf = shift;

  return 1 unless *$slf->{'fil'};
  *$slf->{'fil'} = 0;
  *$slf->{'sep'} = 1;
  return *$slf->{'rpt'}->close;
}

sub flush
{ my $slf = shift;

  *$slf->{'rpt'}->flush if *$slf->{'fil'};
  return *$slf->{'pip'}->flush;
}

sub open  ## no critic (Builtin)
{ my $slf = shift;

  *$slf->{'rpt'}->close if *$slf->{'fil'};
  *$slf->{'pip'}->print("---\n") if *$slf->{'sep'};
  return *$slf->{'fil'} = *$slf->{'rpt'}->open(@_);
}

sub print  ## no critic (Builtin)
{ my $slf = shift;

  *$slf->{'rpt'}->print(@_) if *$slf->{'fil'};
  return *$slf->{'pip'}->print(@_);
}

sub printf  ## no critic (Builtin,Unpack)
{ my $slf = shift;
  my $fmt = shift;
  my $str;

  $str = sprintf($fmt, @_);
  *$slf->{'rpt'}->print($str) if *$slf->{'fil'};
  return *$slf->{'pip'}->print($str);
}

sub write  ## no critic (Builtin)
{ my $slf = shift;

  *$slf->{'rpt'}->write(@_) if *$slf->{'fil'};
  return *$slf->{'pip'}->write(@_);
}

sub BINMODE
{ my $slf = shift;

  return binmode(*$slf->{'rpt'}, @_) if *$slf->{'fil'};
  return;
}

*CLOSE = \&close;
*EOF = \&_not_implemented;
*FILENO = \&_not_implemented;
*GETC = \&_not_implemented;
*OPEN = \&open;
*PRINT = \&print;
*PRINTF = \&printf;
*READ = \&_not_implemented;
*READLINE = \&_not_implemented;
*SEEK = \&_not_implemented;
*TELL = \&_not_implemented;
*WRITE = \&write;

sub DESTROY
{
}

sub TIEHANDLE
{ return shift;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object::Output|RDA::Object::Output>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut