# Common.pm: Class Regrouping Common Collection Methods

package RDA::Limit::Common;

# $Id: Common.pm,v 1.4 2015/11/06 10:35:00 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Limit/Common.pm,v 1.4 2015/11/06 10:35:00 RDA Exp $
#
# Change History
# 20151105  MSC  Add the get_hash method.

=head1 NAME

RDA::Limit::Common - Class Regrouping Common Collection Methods

=head1 SYNOPSIS

 require RDA::Limit::Common;

=head1 DESCRIPTION

The C<RDA::Limit::Common> class regroups common methods for collection limits.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
}

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

# Define the global private constants

# Define the global private variables
my %tb_fmt = (
  age => qr{^(\d+(\.\d+)?)$},
  fmt => qr{^(\w+=\w+(/\w+)+)$},
  pth => qr{^(.*)$},
  );

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

=head1 SELECTOR DEFINITION METHODS

=head2 S<$h-E<gt>get_age_limit($age)>

This methods defines the approach for selecting files based on their age.

=cut

sub get_age_limit
{ my ($slf, $age) = @_;

  return (sub { my ($ctx, $fil, $lim) = @_;
                my (@sta);

                return 0 unless (@sta = stat($fil));
                $ctx->check_stat($fil, @sta);
                return $sta[9] > $lim;
              },
          time - 86400 * $age);
}

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

This methods defines the default approach for selecting any file.

=cut

sub select_item
{ return ();
}

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

This methods defines the default approach for skipping any file.

=cut

sub skip_item
{ return (sub { return 0 });
}

=head1 DEFINITION MANAGEMENT METHODS

=head2 S<$h-E<gt>get_definition($context[,key=E<gt>value...])>

This method returns a reference to the context definition.

=cut

sub get_definition
{ my ($slf, $ctx, @dft) = @_;
  my ($itm);

  return {@dft} unless defined($ctx) && $ctx =~ m{^\w+(\.\w+)*$};
  return $slf->{'_def'}->{$ctx} if exists($slf->{'_def'}->{$ctx});
  $itm = $slf->{'_col'}->get_value(q{LIMIT.}.$ctx.$slf->{'_key'})
    if $slf->{'_col'};
  return $slf->{'_def'}->{$ctx} = (ref($itm) eq 'HASH')
    ? {itm => $itm}
    : {itm => {}, @dft};
}

=head2 S<$h-E<gt>get_hash($context,$key[,$default])>

This method returns the hash associated to a context definition key.

=cut

sub get_hash
{ my ($slf, $ctx, $key, $dft) = @_;
  my ($def, $nam, $val);

  $def = $slf->get_definition($ctx, $key => $dft);
  return (exists($def->{'itm'}->{$key})
    && ref($val = $def->{'itm'}->{$key}) eq 'HASH') ? $val : $dft
}

=head2 S<$h-E<gt>get_value($context,$key[,$default])>

This method returns the value of a context definition key.

=cut

sub get_value
{ my ($slf, $ctx, $key, $dft) = @_;
  my ($def, $nam, $val);

  $def = $slf->get_definition($ctx, $key => $dft);
  return $def->{$key} if exists($def->{$key});
  $val = ($nam =~ m{^(.*)/([ELPTVlptv])$})
    ? $slf->{'_col'}->get_element($2, $1)
    : $slf->{'_col'}->get_first($nam)
    if defined($nam = $def->{'itm'}->{$key});
  return $def->{$key} = ref($val)                                ? $dft :
                        (defined($val) && $val =~ $tb_fmt{$key}) ? $1 :
                                                                   $dft;
}

1;

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object::Buffer|RDA::Object::Buffer>,
L<RDA::Object::Limit|RDA::Object::Limit>,
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