# Table.pm: Class Used for Table Management Macros

package RDA::Library::Table;

# $Id: Table.pm,v 1.11 2014/04/24 17:04:24 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Library/Table.pm,v 1.11 2014/04/24 17:04:24 RDA Exp $
#
# Change History
# 20140424  MSC  Rename the delete method.

=head1 NAME

RDA::Library::Table - Class Used for Table Management Macros

=head1 SYNOPSIS

 require RDA::Library::Table;

=head1 DESCRIPTION

The objects of the C<RDA::Library::Table> class are used to interface with
macros for managing tables.

The following methods are available:

=cut

use strict;

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

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

# Define the global private constants
my $RPT = qr/^RDA::Object::(Pipe|Report)$/i;

# Define the global private variables
my %tb_fct = (
  'addTableColumn'  => [\&_m_add_column,  'N'],
  'addTableRow'     => [\&_m_add_row,     'N'],
  'addTableUid'     => [\&_m_add_uid,     'N'],
  'createTable'     => [\&_m_create,      'N'],
  'deleteTable'     => [\&_m_delete,      'N'],
  'dumpTable'       => [\&_m_dump,        'N'],
  'getTableColumns' => [\&_m_get_columns, 'L'],
  'getTableKeys'    => [\&_m_get_keys,    'L'],
  'getTableOffset'  => [\&_m_get_offset,  'N'],
  'mergeTable'      => [\&_m_merge,       'N'],
  'setTableType'    => [\&_m_set_type,    'N'],
  'writeTable'      => [\&_m_write,       'N'],
  );

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

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

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

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

=over 12

=item S<    B<'_tbl'> > Table hash

=back

=cut

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

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

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

  # Return the object reference
  return $slf;
}

# Clear the table hash for each module
sub reset  ## no critic (Builtin)
{ my ($slf) = @_;

  foreach my $tbl (values(%{$slf->{'_tbl'}}))
  { $tbl->delete_object;
  }
  $slf->{'_tbl'} = {};
  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>run($tbl,$arg,$ctx)>

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

=cut

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

  $fct = $tb_fct{$tbl};
  $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 TABLE MACROS

=head2 S<addTableColumn($tbl,$nam[,$pos[,$fmt[,off,...]]])>

This macro adds a derived column in the table. You can indicate the position
where it must insert the column. It appends after the last column when the
position is an undefined value. The column value is specified by a C<sprintf>
format. The extra arguments indicates the positions of the contributing
columns. On successful completion, it returns a true value. Otherwise, it
returns a false value.

=cut

sub _m_add_column
{ my ($slf, $ctx, $tbl, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Add the column
  return $slf->{'_tbl'}->{$tbl}->add_column(@arg);
}

=head2 S<addTableRow($tbl,$lin)>

This macro adds a row in the table. To reformat time values, you must declare
the time stamp columns before loading rows. On successful completion, it
returns a true value. Otherwise, it returns a false value.

=cut

sub _m_add_row
{ my ($slf, $ctx, $tbl, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Add the row
  return $slf->{'_tbl'}->{$tbl}->add_row(@arg);
}

=head2 S<addTableUid($tbl,$off)>

This macro defines an unique identifier in the table. On successful completion,
it returns a true value. Otherwise, it returns a false value.

=cut

sub _m_add_uid
{ my ($slf, $ctx, $tbl, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Define the unique identifier
  return $slf->{'_tbl'}->{$tbl}->add_uid(@arg);
}

=head2 S<createTable($tbl,$def)>

This macro defines a new table. The columns definition is specified as a string
where the column names are separated by commas or by spaces.

=head2 S<createTable($tbl[,$col1,...])>

This macro defines a new table, with the column names specified as arguments.

On successful completion, it returns a true value. Otherwise, it returns a
false value.

=cut

sub _m_create
{ my ($slf, $ctx, $tbl, @arg) = @_;

  return 0 unless $tbl;

  # Delete any previous table associated to this name
  delete($slf->{'_tbl'}->{$tbl})->delete_object
    if exists($slf->{'_tbl'}->{$tbl});

  # Create the new table
  $slf->{'_tbl'}->{$tbl} = RDA::Object::Table->new($tbl,
    ((scalar @arg) == 1) ? $arg[0] : [@arg]);

  # Indicate the successful completion
  return 1;
}

=head2 S<deleteTable($tbl)>

This macro deletes a table. On successful completion, it returns a true
value. Otherwise, it returns a false value.

=cut

sub _m_delete
{ my ($slf, $ctx, $tbl) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Delete the table
  $slf->{'_tbl'}->{$tbl}->delete_object;
  return 1;
}

=head2 S<dumpTable($tbl)>

This macro returns the table definition.

=cut

sub _m_dump
{ my ($slf, $ctx, $tbl) = @_;

  # Abort when the table is not defined
  return unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Return the table definition
  return $slf->{'_tbl'}->{$tbl}->dump;
}

=head2 S<getTableColumns($tbl)>

This macro returns the list of column names.

=cut

sub _m_get_columns
{ my ($slf, $ctx, $tbl) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Get the column names
  return $slf->{'_tbl'}->{$tbl}->get_columns;
}

=head2 S<getTableKeys($tbl,$off)>

This macro returns the list of distinct values present in a column.

=cut

sub _m_get_keys
{ my ($slf, $ctx, $tbl, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Get the column keys
  return $slf->{'_tbl'}->{$tbl}->get_keys(@arg);
}

=head2 S<getTableOffset($tbl,$nam)>

This macro returns the offset of the specified column name. It returns an
undefined value if it does not find the column.

=cut

sub _m_get_offset
{ my ($slf, $ctx, $tbl, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Get the column offset
  return $slf->{'_tbl'}->{$tbl}->get_offset(@arg);
}

=head2 S<mergeTable($dst,$src,$off,$dst1,$src1,...)>

This macro merges source fields inside the destination table. It makes a join
between the specified destination column and the source table unique identifier.

On successful completion, it returns a true value. Otherwise, it returns a
false value.

=cut

sub _m_merge
{ my ($slf, $ctx, $dst, $src, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $dst && exists($slf->{'_tbl'}->{$dst});
                  $src && exists($slf->{'_tbl'}->{$src});

  # Merge the table
  return $slf->{'_tbl'}->{$dst}->merge($slf->{'_tbl'}->{$src}, @arg);
}

=head2 S<setTableType($tbl,$typ,$off,...)>

This macro modifies the type of the specified columns. It supports the
following types:

=over 10

=item B<    NUM  > Numeric value

=item B<    STR  > String

=item B<    TSP  > Time stamp

=back

It discards non-existent column names and returns the number of modified
columns.

=cut

sub _m_set_type
{ my ($slf, $ctx, $tbl, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Modify the column type
  return $slf->{'_tbl'}->{$tbl}->set_type(@arg);
}

=head2 S<writeTable([$rpt,]$tbl[,$sort,...])>

This macro writes the table content in the report. You can suffix sort
directives by C</A> or C</D> for sorting the corresponding values ascending
or descending. It derives the column headings from the column names.

It returns the number of rows effectively written in the report.

=cut

sub _m_write
{ my ($slf, $ctx, $arg, @arg) = @_;
  my ($rpt);

  return
    (ref($arg) =~ $RPT)       ? _s_write($slf, $ctx, $arg, @arg) :
    ($rpt = $ctx->get_report) ? _s_write($slf, $ctx, $rpt, $arg, @arg) :
                                0;
}

sub _s_write
{ my ($slf, $ctx, $rpt, $tbl, @arg) = @_;

  # Abort when the table is not defined
  return 0 unless $tbl && exists($slf->{'_tbl'}->{$tbl});

  # Add the rows
  return $slf->{'_tbl'}->{$tbl}->write($rpt,
    ((scalar @arg) == 1) ? $arg[0] : [@arg]);
}

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::Table|RDA::Object::Table>,
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