# Product.pm: Class Used for Product Inventory Macros

package RDA::Library::Product;

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

=head1 NAME

RDA::Library::Product - Class Used for Product Inventory Macros

=head1 SYNOPSIS

 require RDA::Library::Product;

=head1 DESCRIPTION

The objects of the C<RDA::Library::Product> class are used to interface with
product inventory-related macros.

The following methods are available:

=cut

use strict;

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

# Define the global public variables
use vars qw($STRINGS $SUSPEND $VERSION @ISA);
$SUSPEND = {
  _tgt => 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 = (
  'getComponentLocation' => [\&_m_get_cmp_location, 'T'],
  'getComponentVersion'  => [\&_m_get_cmp_version,  'T'],
  'getProductName'       => [\&_m_get_prd_name,     'T'],
  'getProductVersion'    => [\&_m_get_prd_version,  'T'],
  'getTopProductVersion' => [\&_m_get_top_version,  'T'],
  'getTopProducts'       => [\&_m_get_top_names,    'L'],
  'hasInventory'         => [\&_m_has_inventory,    'N'],
  );

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

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

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

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

=over 12

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

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

=item S<    B<'_tgt'> > Target hash

=back

Internal keys are prefixed by an underscore.

=cut

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

  # Create the macro object
  $slf = bless {
    _cfg => $col->get_config,
    _tgt => {},
    }, ref($cls) || $cls;

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

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

=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 INVENTORY MACROS

=head2 S<getComponentLocation($home,$name[,$default])>

This macro returns the location of the specified component. It returns the
default value when there is no inventory information.

=cut

sub _m_get_cmp_location
{ my ($slf, $ctx, $hom, $nam, $dft) = @_;

  return _get_target($slf, $hom)->get_location($nam, $dft);
}

=head2 S<getComponentVersion($home,$name[,$default])>

This macro returns the version of the specified component. You can prefix the
name by:

=over 6

=item C<A|>  To consider a top product also

=item C<a|>  To consider a top product also but ignoring patches and patch sets

=item C<C|>  To restrict the search to a component

=item C<c|>  To restrict the search to a component, ignoring patches

=item C<T|>  To restrict the search to a top product

=item C<t|>  To restrict the search to a top product, ignoring patch sets

=back

It returns the default value when there is no inventory information.

=cut

sub _m_get_cmp_version
{ my ($slf, $ctx, $hom, $nam, $dft) = @_;

  return _get_target($slf, $hom)->get_version(($nam =~ m/^\w\|/)
    ? $nam
    : "C|$nam", $dft);
}

=head2 S<getProductName($home[,$default])>

This macro returns the extended name of the product. It returns the default
value when there is no inventory information.

=cut

sub _m_get_prd_name
{ my ($slf, $ctx, $hom, $dft) = @_;

  return _get_target($slf, $hom)->get_product($dft);
}

=head2 S<getProductVersion($home[,$default])>

This macro returns the version of the product. It returns the default value
when there is no inventory information.

=cut

sub _m_get_prd_version
{ my ($slf, $ctx, $hom, $dft) = @_;

  return _get_target($slf, $hom)->get_version(undef, $dft);
}

=head2 S<getTopProductVersion($home,$name[,$default])>

This macro returns the version of the specified top product. It returns the
default value when there is no inventory information.

=cut

sub _m_get_top_version
{ my ($slf, $ctx, $hom, $nam, $dft) = @_;

  return _get_target($slf,$hom)->get_version(($nam =~ m/^\w\|/)
    ? $nam
    : "T|$nam", $dft);
}

=head2 S<getTopProducts($home[,$name...])>

This macro returns the list of existing top product names. You can restrict the
names to the provided arguments.

=cut

sub _m_get_top_names
{ my ($slf, $ctx, $hom, @flt) = @_;

  return _get_target($slf, $hom)->get_products(@flt);
}

=head2 S<hasInventory($home)>

This macro indicates the type of the inventory used for the auto discovery. It
returns an empty string when no inventory is available.

=cut

sub _m_has_inventory
{ my ($slf, $ctx, $hom) = @_;

  return _get_target($slf, $hom)->has_inventory;
}

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

# Get the auto discovery object
sub _get_target
{ my ($slf, $hom) = @_;

  return $slf->{'_tgt'}->{$hom} if exists($slf->{'_tgt'}->{$hom});
  return $slf->{'_tgt'}->{$hom} =
    RDA::Driver::Product->new($slf->{'_col'}, $hom);
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Driver::Library|RDA::Driver::Library>,
L<RDA::Driver::Product|RDA::Driver::Product>,
L<RDA::Object|RDA::Object>,
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