# Temp.pm: Class Used for Temporary File Management Macros

package RDA::Library::Temp;

# $Id: Temp.pm,v 1.11 2014/11/07 18:06:49 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Library/Temp.pm,v 1.11 2014/11/07 18:06:49 RDA Exp $
#
# Change History
# 20141107  MSC  Add the refresh method.

=head1 NAME

RDA::Library::Temp - Class Used for Temporary File Management Macros

=head1 SYNOPSIS

 require RDA::Library::Temp;

=head1 DESCRIPTION

The objects of the C<RDA::Library::Temp> class are used to interface with
temporary file management macros.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Driver::Library;
  use RDA::Text qw(get_string);
  use RDA::Object;
  use RDA::Value::List;
  use RDA::Value::Scalar qw(:value);
}

# Define the global public variables
use vars qw($STRINGS $SUSPEND $VERSION @ISA);
$SUSPEND = {
  _tmp => sub{return{}},
  };
$VERSION = sprintf('%d.%02d', q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(RDA::Driver::Library Exporter);

# Define the global private constants

# Define the global private variables
my %tb_fct = (
  'closeTemp'         => [\&_m_close_temp,     'N'],
  'createTemp'        => [\&_m_create_temp,    'T'],
  'getTemp'           => [\&_m_get_temp,       'T'],
  'newTemp'           => [\&_m_new_temp,       'T'],
  'unlinkTemp'        => [\&_m_unlink_temp,    'N'],
  'writeTempPassword' => [\&_m_write_password, 'N'],
  'writeTemp'         => [\&_m_write_temp,     'N'],
  );

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

=head2 S<$h = RDA::Library::Temp-E<gt>new($driver,$collector)>

The object constructor. It takes the library driver and collector references as
arguments.

C<RDA::Library::Temp> is represented by a blessed hash reference. The
following special keys are used:

=over 12

=item S<    B<'_col'> > Reference to the collector object

=item S<    B<'_tmp'> > Hash containing the temporary file definitions

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $drv, $col) = @_;
  my ($slf);

  # Create the macro object
  $slf = bless {
    _tmp => {},
    }, ref($cls) || $cls;

  # Register the macros
  $drv->register($slf, [keys(%tb_fct)], qw(refresh reset suspend));

  # Return the object reference
  return refresh($slf, $col);
}

# Clear the temporary file hash for each module
sub reset  ## no critic (Builtin)
{ shift->{'_tmp'} = {};
  return;
}

=head2 S<$h-E<gt>call($name,...)>

This method executes the macro code.

=cut

sub call
{ my ($slf, $nam, @arg) = @_;

  return &{$tb_fct{$nam}->[0]}($slf, @arg);
}

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

This method deletes the library control object.

=cut

sub delete_object
{ RDA::Object::dump_caller($_[0], 'Library') if $RDA::Object::DELETE;
  undef %{$_[0]};
  undef $_[0];
  return;
}

=head2 S<$h-E<gt>refresh($col)>

This method updates the library control object for a new collector.

=cut

sub refresh
{ my ($slf, $col) = @_;

  $slf->{'_col'} = $col;
  return $slf;
}

=head2 S<$h-E<gt>run($name,$arg,$ctx)>

This method executes the macro with the specified argument list in a given
context.

=cut

sub run
{ my ($slf, $nam, $arg, $ctx) = @_;
  my ($fct, $ret, $typ);

  $fct = $tb_fct{$nam};
  $typ = $fct->[1];

  # Treat an array context
  return RDA::Value::List::new_from_data(&{$fct->[0]}($slf, $ctx,
    $arg->eval_as_array)) if $typ eq 'L';

  # Treat a scalar context
  return defined($ret = &{$fct->[0]}($slf, $ctx, $arg->eval_as_array))
    ? RDA::Value::Scalar->new($typ, $ret)
    : $VAL_UNDEF;
}

=head1 TEMPORARY FILE MACROS

=head2 S<closeTemp($name)>

This macro closes the specified temporary file. It returns 1 on successful
completion and 0 if the file was not previously defined.

=cut

sub _m_close_temp
{ my ($slf, $ctx, $nam) = @_;

  return 0 unless exists($slf->{'_tmp'}->{$nam});

  $slf->{'_tmp'}->{$nam}->close;
  return 1;
}

=head2 S<createTemp($name[,$suffix[,$flag]])>

This macro creates a temporary file name based on the specified name, used as a
unique identifier for other requests. It uses C<.tmp> as the default suffix and
removes any previous file. When the flag is specified, the temporary file is
only accessible for the file owner. When the flag is set, the file is made
executable at closing time.

It returns the file name on successful completion. Otherwise, it returns an
undefined value.

=cut

sub _m_create_temp
{ my ($slf, $ctx, $nam, $suf, $flg) = @_;

  # Delete any temporary file previously associated with that name
  $ctx->get_output->end_temp(delete($slf->{'_tmp'}->{$nam}))
    if exists($slf->{'_tmp'}->{$nam});

  # Define the new temporary file
  return _new_tmp($slf, $ctx, 1, $nam, $suf, $flg)->get_file;
}

=head2 S<getTemp($name[,$suffix])>

This macro generates a temporary file name based on the specified name, which
is used as a unique identifier for other requests. It uses C<.tmp> as the
default suffix.

=cut

sub _m_get_temp
{ my ($slf, $ctx, $nam, $suf) = @_;

  return (exists($slf->{'_tmp'}->{$nam})
    ? $slf->{'_tmp'}->{$nam}
    : _new_tmp($slf, $ctx, 1, $nam, $suf))->get_file;
}

=head2 S<newTemp($name[,$suffix])>

This macro generates a temporary file name based on the specified name, which
is used as a unique identifier for other requests. It uses C<.tmp> as the
default suffix. It takes care that the file does not exists but well the
temporary directory.

=cut

sub _m_new_temp
{ my ($slf, $ctx, $nam, $suf) = @_;
  my ($out, $pth);

  # Delete any temporary file previously associated with that name
  $out = $ctx->get_output;
  $out->end_temp(delete($slf->{'_tmp'}->{$nam}))
    if exists($slf->{'_tmp'}->{$nam});

  # Define the new temporary file
  $slf->{'_col'}->get_dir('T', 1);
  $pth = _new_tmp($slf, $ctx, 0, $nam, $suf)->get_file;
  1 while unlink($pth);
  return $pth;
}

=head2 S<unlinkTemp($name)>

This macro unlinks a temporary file. It returns 1 for a successful
completion. Otherwise, it returns 0.

=cut

sub _m_unlink_temp
{ my ($slf, $ctx, $nam) = @_;

  return 0 unless exists($slf->{'_tmp'}->{$nam});

  $ctx->get_output->end_temp(delete($slf->{'_tmp'}->{$nam}));
  return 1;
}

=head2 S<writeTempPassword($name,$format,$type,$sid,$user[,$text[,$default]])>

This macro adds the password string to the report stream. It returns the number
of bytes actually written, or an undefined value if there was an error.

=cut

sub _m_write_password
{ my ($slf, $ctx, $nam, $fmt, @pwd) = @_;
  my ($tmp);

  # Get the temporary file definition
  $tmp = exists($slf->{'_tmp'}->{$nam})
    ? $slf->{'_tmp'}->{$nam}
    : _new_tmp($slf, $ctx, 0, $nam);

  # Add the password string to the temporary file
  return defined($fmt)
    ? $tmp->write(sprintf($fmt, $slf->{'_col'}->get_access->get_password(@pwd)))
    : 0;
}

=head2 S<writeTemp($name[,$str...])>

This macro writes a line in the temporary file. It returns the number of bytes
written.

=cut

sub _m_write_temp
{ my ($slf, $ctx, $nam, @arg) = @_;
  my ($tmp);

  # Get the temporary file definition
  $tmp = exists($slf->{'_tmp'}->{$nam})
    ? $slf->{'_tmp'}->{$nam}
    : _new_tmp($slf, $ctx, 0, $nam);

  # Write the line
  return $tmp->write(join(q{}, grep {defined($_)} @arg).qq{\n});
}

#--- Internal routines --------------------------------------------------------

# Define a new temporary file
sub _new_tmp
{ my ($slf, $ctx, $flg, $nam, $suf, $exe) = @_;
  my ($ctl);

  $ctl = $ctx->get_output->add_temp($nam, $suf, $exe);
  if ($flg)
  { $ctl->create;
    $ctl->close;
  }
  return $slf->{'_tmp'}->{$nam} = $ctl;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Driver::Library|RDA::Driver::Library>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Output|RDA::Object::Output>,
L<RDA::Object::Report|RDA::Object::Report>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::Text|RDA::Text>,
L<RDA::Value::List|RDA::Value::List>,
L<RDA::Value::Scalar|RDA::Value::Scalar>

=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