# Rda.pm: Class Used for Managing the RDA Software Configuration

package RDA::Object::Rda;

# $Id: Rda.pm,v 1.46 2015/10/19 04:40:32 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Rda.pm,v 1.46 2015/10/19 04:40:32 RDA Exp $
#
# Change History
# 20151019  MSC  Support Windows disks where short names are not available.

=head1 NAME

RDA::Object::Rda - Class Used for Managing the RDA Software Configuration

=head1 SYNOPSIS

 require RDA::Object::Rda;

=head1 DESCRIPTION

This package is designed to manage the RDA software configuration. It is a
subclass of L<RDA::Object|RDA::Object>.

It supports RDA operations commonly performed on file names. Since these
functions are different for most operating systems, each set of operating
system-specific routines is available in a separate module, including:

=over 4

=item S<    L<RDA::Local::Cygwin|RDA::Local::Cygwin>>

=item S<    L<RDA::Local::Unix|RDA::Local::Unix>>

=item S<    L<RDA::Local::Vms|RDA::Local::Vms>>

=item S<    L<RDA::Local::Windows|RDA::Local::Windows>>

=back

The module appropriate for the current operating system is automatically loaded
by C<RDA::Object::Rda>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Cwd qw(getcwd);
  use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Object;
}

# Define the global public variables
use vars qw($APPEND $CREATE $DIR_PERMS $EXE_PERMS $FIL_PERMS $TMP_PERMS
            $RDA_LOCAL $STRINGS $VERSION @ISA @EXPORT_OK %SDCL);
$VERSION   = sprintf('%d.%02d', q$Revision: 1.46 $ =~ /(\d+)\.(\d+)/);
@EXPORT_OK = qw($APPEND $CREATE $DIR_PERMS $EXE_PERMS $FIL_PERMS $TMP_PERMS
                $RDA_LOCAL);
%SDCL      = (
  als => {
    ## no critic (Interpolation)
    'basename'      => ['$[RDA]', 'basename'],
    'canFork'       => ['$[RDA]', 'can_fork'],
    'canThread'     => ['$[RDA]', 'can_fork'],
    'cleanNative'   => ['$[RDA]', 'clean_native'],
    'cleanPath'     => ['$[RDA]', 'clean_path'],
    'curDir'        => ['$[RDA]', 'current_dir'],
    'dirname'       => ['$[RDA]', 'dirname'],
    'getDevNull'    => ['$[RDA]', 'dev_null'],
    'getDevTty'     => ['$[RDA]', 'dev_tty'],
    'getFamily'     => ['$[RDA]', 'get_family'],
    'getGmTime'     => ['$[RDA]', 'get_gmtime'],
    'getGroup'      => ['$[RDA]', 'get_group'],
    'getGroupDir'   => ['$[RDA]', 'get_dir'],
    'getGroupFile'  => ['$[RDA]', 'get_file'],
    'getLocalTime'  => ['$[RDA]', 'get_localtime'],
    'getNativePath' => ['$[RDA]', 'native'],
    'getOsName'     => ['$[RDA]', 'get_os'],
    'getPid'        => ['$[RDA]', 'get_pid'],
    'getRunId'      => ['$[RDA]', 'get_run'],
    'getShortPath'  => ['$[RDA]', 'short'],
    'getTimeStamp'  => ['$[RDA]', 'get_timestamp'],
    'hasShortPath'  => ['$[RDA]', 'has_short'],
    'isAbsolute'    => ['$[RDA]', 'is_absolute'],
    'isCygwin'      => ['$[RDA]', 'is_cygwin'],
    'isTainted'     => ['$[RDA]', 'is_tainted'],
    'isUnix'        => ['$[RDA]', 'is_unix'],
    'isVms'         => ['$[RDA]', 'is_vms'],
    'isWindows'     => ['$[RDA]', 'is_windows'],
    'parsePath'     => ['$[RDA]', 'parse_path'],
    'quote'         => ['$[RDA]', 'quote'],
    'quote2'        => ['$[RDA]', 'quote2'],
    're'            => ['$[RDA]', 're'],
    'testRda'       => ['$[RDA]', 'check'],
    'uname'         => ['$[RDA]', 'uname'],
    'unquote'       => ['$[RDA]', 'unquote'],
    'user'          => ['$[RDA]', 'get_user'],
    'upDir'         => ['$[RDA]', 'up_dir'],
     },
  inc => [qw(RDA::Object)],
  met => {
    'arg_dir'       => {ret => 0},
    'arg_file'      => {ret => 0},
    'as_bat'        => {ret => 0},
    'as_cmd'        => {ret => 0},
    'as_exe'        => {ret => 0},
    'basename'      => {ret => 0},
    'can_flock'     => {ret => 0},
    'can_fork'      => {ret => 0},
    'cat_dir'       => {ret => 0},
    'cat_file'      => {ret => 0},
    'cat_native'    => {ret => 0},
    'check'         => {ret => 0},
    'clean_dir'     => {ret => 0},
    'clean_group'   => {ret => 0},
    'clean_native'  => {ret => 0},
    'clean_path'    => {ret => 0},
    'create_dir'    => {ret => 0},
    'create_group'  => {ret => 0},
    'current_dir'   => {ret => 0},
    'delete_dir'    => {ret => 0},
    'delete_group'  => {ret => 0},
    'dev_null'      => {ret => 0},
    'dev_tty'       => {ret => 0},
    'dirname'       => {ret => 0},
    'find'          => {ret => 0},
    'get_build'     => {ret => 0},
    'get_columns'   => {ret => 0},
    'get_degree'    => {ret => 0},
    'get_degrees'   => {ret => 1},
    'get_dir'       => {ret => 0},
    'get_domain'    => {ret => 0},
    'get_family'    => {ret => 0},
    'get_file'      => {ret => 0},
    'get_gmtime'    => {ret => 0},
    'get_group'     => {ret => 0},
    'get_host'      => {ret => 0},
    'get_info'      => {ret => 0},
    'get_localtime' => {ret => 0},
    'get_login'     => {ret => 0},
    'get_node'      => {ret => 0},
    'get_obsolete'  => {ret => 1},
    'get_os'        => {ret => 0},
    'get_path'      => {ret => 1},
    'get_pid'       => {ret => 0},
    'get_run'       => {ret => 0},
    'get_separator' => {ret => 0},
    'get_timestamp' => {ret => 0},
    'get_title'     => {ret => 0},
    'get_tz'        => {ret => 1},
    'get_user'      => {ret => 0},
    'get_value'     => {ret => 0},
    'get_version'   => {ret => 0},
    'get_work'      => {ret => 0},
    'has_short'     => {ret => 0},
    'is_absolute'   => {ret => 0},
    'is_cygwin'     => {ret => 0},
    'is_root_dir'   => {ret => 0},
    'is_tainted'    => {ret => 0},
    'is_unix'       => {ret => 0},
    'is_vms'        => {ret => 0},
    'is_windows'    => {ret => 0},
    'kill_child'    => {ret => 0},
    'native'        => {ret => 0},
    'parse_path'    => {ret => 1},
    'quote'         => {ret => 0},
    'quote2'        => {ret => 0},
    're'            => {ret => 0},
    'set_context'   => {ret => 0},
    'set_domain'    => {ret => 0},
    'set_info'      => {ret => 0},
    'short'         => {ret => 0},
    'split_dir'     => {ret => 1},
    'split_volume'  => {ret => 1},
    'uname'         => {ret => 0},
    'unquote'       => {ret => 0},
    'up_dir'        => {ret => 0},
    },
  top => 'RDA',
  );

# Determine which platform-specific package must be loaded
my %tb_fam = (
  'aix'        => 'Unix',
  'bsdos'      => 'Unix',
  'cygwin'     => 'Cygwin',
  'darwin'     => 'Unix',
  'dec_osf'    => 'Unix',
  'dgux'       => 'Unix',
  'dynixptx'   => 'Unix',
  'freebsd'    => 'Unix',
  'hpux'       => 'Unix',
  'irix'       => 'Unix',
  'linux'      => 'Unix',
  'MSWin32'    => 'Windows',
  'MSWin64'    => 'Windows',
  'next'       => 'Unix',
  'openbsd'    => 'Unix',
  'svr4'       => 'Unix',
  'sco_sv'     => 'Unix',
  'solaris'    => 'Unix',
  'sunos'      => 'Unix',
  'VMS'        => 'Vms',
  'Windows_NT' => 'Windows',
  );
$RDA_LOCAL = $tb_fam{$^O} || 'Unix';
require "RDA/Local/$RDA_LOCAL.pm";  ## no critic (Bareword)
@ISA = ("RDA::Local::$RDA_LOCAL", 'RDA::Object', 'Exporter');

# Define file modes
$APPEND = '>>';
$CREATE = '>';
eval {
  require Fcntl;
  ## no critic (Bit)
  $APPEND = Fcntl::O_WRONLY() | Fcntl::O_CREAT() | Fcntl::O_APPEND();
  $CREATE = Fcntl::O_WRONLY() | Fcntl::O_CREAT() | Fcntl::O_TRUNC();
  };

# Define default permissions
$DIR_PERMS = 0750;  ## no critic (Number,Zero)
$EXE_PERMS = 0700;  ## no critic (Number,Zero)
$FIL_PERMS = 0640;  ## no critic (Number,Zero)
$TMP_PERMS = 0600;  ## no critic (Number,Zero)

# Define the global private constants

# Define the global private variables
my @tb_mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my %tb_dir = (
  dft => {D_RDA_ADM => ['admin'],
          D_RDA_CHK => ['hcve'],
          D_RDA_COL => ['collect'],
          D_RDA_CSS => ['admin', 'css'],
          D_RDA_DAT => ['admin', 'data'],
          D_RDA_DFW => ['dfw'],
          D_RDA_HOM => [],
          D_RDA_INC => [],
          D_RDA_MOD => ['modules'],
          D_RDA_MSG => ['mesg'],
          D_RDA_POD => ['Pod'],
          D_RDA_REL => ['admin', 'data'],
          D_RDA_TST => ['admin', 'test'],
         },
  izu => {D_RDA_ADM => ['rda', 'admin'],
          D_RDA_CHK => [RDA::Object::Rda->up_dir, 'html'],
          D_RDA_COL => ['rda', 'collect'],
          D_RDA_CSS => [RDA::Object::Rda->up_dir, 'html'],
          D_RDA_DAT => ['rda', 'admin', 'data'],
          D_RDA_DFW => ['rda', 'dfw'],
          D_RDA_HOM => ['rda'],
          D_RDA_INC => [RDA::Object::Rda->up_dir, 'perl'],
          D_RDA_MOD => ['rda', 'modules'],
          D_RDA_MSG => ['rda', 'mesg'],
          D_RDA_POD => [RDA::Object::Rda->up_dir, 'perl', 'Pod'],
          D_RDA_REL => ['rda', 'admin', 'data'],
          D_RDA_TST => ['rda', 'admin', 'test'],
         },
  );
my %tb_fct = (
  B_CYGWIN    => 'is_cygwin',
  B_UNIX      => 'is_unix',
  B_VMS       => 'is_vms',
  B_WINDOWS   => 'is_windows',
  K_RUN       => \&get_run,
  N_BUILD     => \&get_build,
  N_COLUMNS   => \&get_columns,
  N_ENGINE    => \&check,
  N_PID       => \&get_pid,
  T_DOMAIN    => \&get_domain,
  T_FAMILY    => \&get_family,
  T_GMTIME    => \&get_gmtime,
  T_HOST      => \&get_host,
  T_LOCALTIME => \&get_localtime,
  T_LOGIN     => 'get_login',
  T_MACHINE   => \&get_node,
  T_NODE      => \&get_node,
  T_OS        => \&get_os,
  T_SEPARATOR => 'get_separator',
  T_TIMESTAMP => \&get_timestamp,
  T_TZ        => \&get_tz,
  T_USER      => 'get_user',
  V_PERL      => \&get_perl_version,
  V_VERSION   => \&get_version,
  );
my %tb_fnd = (
  Cygwin  => \&_find_windows,  ## no critic (Call)
  Unix    => \&_find_unix,     ## no critic (Call)
  Vms     => \&_find_vms,      ## no critic (Call)
  Windows => \&_find_windows,  ## no critic (Call)
  );
my %tb_lib = (
  'aix'    => ['LIBPATH'],
  'darwin' => ['DYLD_LIBRARY_PATH'],
  'hpux'   => ['SHLIB_PATH', 'LD_LIBRARY_PATH'],
  'unix'   => ['LD_LIBRARY_PATH'],
  );
my %tb_sys = (
  's' => 0,
  'n' => 1,
  'r' => 2,
  'v' => 3,
  'm' => 4,
  );
my %tb_ver = (
  IRDA => [1,  1],
  RDA  => [1, 50],
  SDCI => [1, 44],
  );

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

=head2 S<$h = RDA::Object::Rda-E<gt>new($agent)>

This method converts the RDA software configuration hash into an object.

C<RDA::Object::Rda> 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<'aux' > > Reference to an auxiliary object

=item S<    B<'def' > > List of predefined properties

=item S<    B<'dyn' > > Dynamic work directory indicator

=item S<    B<'oid' > > Agent object identifier

=item S<    B<'sys' > > Reference to the system view object

=item S<    B<'typ' > > Software configuration type

=item S<    B<'ver' > > Start script version

=item S<    B<'_bld'> > Current software build

=item S<    B<'_chk'> > Engine check indicator

=item S<    B<'_cmp'> > Compiled element hash

=item S<    B<'_cnt'> > Counter hash

=item S<    B<'_con'> > Reference to DOS console object

=item S<    B<'_dom'> > Local domain

=item S<    B<'_eng'> > Current engine build

=item S<    B<'_fam'> > Operating system family

=item S<    B<'_flk'> > Indicates whether flock can be used

=item S<    B<'_frk'> > Indicates whether forking can be done

=item S<    B<'_log'> > Login name

=item S<    B<'_lvl'> > Setting level hash

=item S<    B<'_nod'> > Local node name

=item S<    B<'_obs'> > Obsolete object hash

=item S<    B<'_osn'> > Operating system name

=item S<    B<'_sht'> > Short definition hash

=item S<    B<'_txt'> > Text control object reference

=item S<    B<'_usr'> > User name

=item S<    B<'_ver'> > Software version

=back

Internal keys are prefixed by an underscore.

=cut

sub new  ## no critic (Complex)
{ my ($cls, $agt) = @_;
  my ($flg, $slf, $sys, $val, %dir);

  # Convert the configuration hash into an object
  $slf = $agt->get_config;
  bless $slf, $cls;

  # Normalize all directories
  $flg = $slf->{'B_NO_CLEAN'} ? 0 : 1;
  $slf->{'D_HOM'} = __PACKAGE__->clean_path(
    [$val = exists($slf->{'D_RDA'}) ? $slf->{'D_RDA'} : getcwd(), q{}], $flg);
  foreach my $key (keys(%{$slf}))
  { $slf->{$key} = __PACKAGE__->short(__PACKAGE__->clean_path(
      __PACKAGE__->is_absolute($slf->{$key})
        ? [$slf->{$key}, q{}]
        : [$val, $slf->{$key}, q{}], $flg))
      if $key =~ m/^D_(CWD|RDA(_\w+)?)$/ && $key ne 'D_RDA_INC';
  }

  # Initialize extra attributes
  $slf->{'agt'} = $agt;
  $slf->{'def'} = [grep {m/^[A-Z]_/} sort keys(%{$slf})];
  $slf->{'oid'} = $agt->get_oid;
  $slf->{'sys'} = $sys = $agt->get_system;
  $slf->{'typ'} = 'dft' unless exists($slf->{'typ'});

  $slf->{'_cmp'} = {};
  $slf->{'_fam'} = exists($tb_fam{$^O}) ? $tb_fam{$^O} : $^O;
  $slf->{'_flk'} = $slf->{'_frk'} = 0
    if exists($slf->{'B_FORK'}) && $slf->{'B_FORK'} == 0;
  $slf->{'_osn'} = $^O;

  $slf->{'B_CASE'} = $sys->get_value('RDA_CASE', $^O ne 'VMS')
    unless exists($slf->{'B_CASE'});
  $slf->{'B_TAINTED'} = $sys->get_info('flg');
  $slf->{'N_BASENAME'} = ($^O eq 'VMS') ? 38 : 64
    unless exists($slf->{'N_BASENAME'});
  $slf->{'N_COLUMNS'} = $sys->get_value('COLUMNS', 80) - 2
    unless exists($slf->{'N_COLUMNS'});
  $slf->{'T_LINE'} = q{-} x $slf->{'N_COLUMNS'};

  # Determine the Perl commands
  if ($0 =~ m/\b(rda|sdci).pl$/i)
  { my $fil = "$1.pl";
    if ($^X =~ m/\b(rda|sdci)(\.exe|_\w+56)$/i)
    { _get_rda1($slf);
    }
    else
    { _get_rda2($slf, $fil);
    }
  }
  else
  { _get_rda1($slf);
  }

  # Determine the machine name
  $slf->{'_nod'} = 'localhost';
  $slf->{'_dom'} = undef;
  eval {
    require Sys::Hostname;
    $val = Sys::Hostname::hostname();
    ($slf->{'_nod'}, $slf->{'_dom'}) = ($1, $3)
      if $val && $val =~ m/^([^\.]+)(\.(.*))?$/;
  };

  # Adjust RDA context
  if (defined($val = $sys->get_value('RDAPERL')))
  { %dir = map {$_ => 1} @INC;
    foreach my $dir (split($slf->get_separator, $val))
    { unshift(@INC, $slf->cat_dir($dir))
        if -d ($dir = __PACKAGE__->clean_path($dir =~ m/^([\000-\377]+)$/))
        && !exists($dir{$dir});
    }
  }

  # Initialise the text control object
  $slf->{'_txt'} = RDA::Text->new($slf, $agt);

  # Return the object reference
  return $slf;
}

sub _get_rda1
{ my ($slf) = @_;
  my ($prl, $pth);

  $prl = __PACKAGE__->is_path($^X);
  $pth = __PACKAGE__->is_absolute($prl)
      ? $prl
      : __PACKAGE__->cat_file($slf->{'D_RDA'}, __PACKAGE__->basename($prl));
  $slf->{'T_SELF'} = [$pth];
  $slf->{'T_LOCAL'} = __PACKAGE__->quote($pth);
  $slf->{'T_NATIVE'} = __PACKAGE__->quote(__PACKAGE__->native($pth));
  $slf->{'T_SHORT'} = (__PACKAGE__->is_windows || __PACKAGE__->is_cygwin)
    ? __PACKAGE__->quote(__PACKAGE__->short($pth))
    : $slf->{'T_NATIVE'};
  return;
}

sub _get_rda2
{ my ($slf, $fil) = @_;
  my ($prl, $pth, @opt);

  @opt = ('-T') if $slf->{'B_TAINTED'};

  $slf->{'T_PERL'} = $prl = __PACKAGE__->is_path($^X);
  $pth = __PACKAGE__->cat_file($slf->{'D_RDA'}, $fil);
  $slf->{'T_SELF'} =
    [$prl, @opt, __PACKAGE__->is_windows ? __PACKAGE__->quote($pth) : $pth];
  $slf->{'T_LOCAL'} = join(q{ }, __PACKAGE__->quote($prl),
    @opt, __PACKAGE__->quote($pth));
  $slf->{'T_NATIVE'} = join(q{ }, __PACKAGE__->quote(__PACKAGE__->native($prl)),
    @opt, __PACKAGE__->quote(__PACKAGE__->native($pth)));
  $slf->{'T_SHORT'} = (__PACKAGE__->is_windows || __PACKAGE__->is_cygwin)
    ? join(q{ }, __PACKAGE__->quote(__PACKAGE__->short($prl)), @opt,
                 __PACKAGE__->quote(__PACKAGE__->short($pth)))
    : $slf->{'T_NATIVE'};
  return;
}

sub new_dft
{ return bless {cod => 'dft'}, __PACKAGE__;
}

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

This method indicates when flock can be used. It returns a null value when
flock is not available. The return value is negative when fork is emulated.

=cut

sub can_flock
{ return _chk_can(shift, '_flk');
}

sub _chk_can
{ my ($slf, $key) = @_;

  # Check the system capabilities
  unless (exists($slf->{$key}))
  { $slf->{'_flk'} = $slf->{'_frk'} = 0;
    unless ($^O eq 'VMS')
    { $slf->{'_flk'} = 1;
      eval {
        my $pid;

        die "No fork\n" unless defined($pid = fork());
        exit(0) unless $pid;
        waitpid($pid, 0);
        if ($pid < 0)
        { $slf->{'_frk'} = -1;
          $slf->{'_flk'} = -$slf->{'_flk'};
        }
        else
        { $slf->{'_frk'} = 1;
        }
      };
    }
  }
  return $slf->{$key};
}

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

This method indicates that RDA can fork processes. It returns a positive value
to indicate that fork is implemented, a negative value when fork is emulated,
and otherwise, zero.

=cut

sub can_fork
{ return _chk_can(shift, '_frk');
}

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

This method checks that the RDA engine code is not obsolete. It generates an
error when the engine is obsolete. Otherwise, it returns the engine build.

=cut

sub check
{ my ($slf) = @_;
  my ($typ, $ver, @ver);

  # Check the start script version
  die get_string('NO_VERSION') unless exists($slf->{'ver'});
  ($typ, @ver) = split(/\./, $slf->{'ver'});
  if (exists($tb_ver{$typ}))
  { foreach my $ref (@{$tb_ver{$typ}})
    { $ver = shift(@ver);
      last if $ver > $ref;
      die get_string('BAD_VERSION') if $ver < $ref;
    }
  }

  # Check the library version
  return check_engine($slf, $slf->{'B_NO_CHECK'});
}

sub check_engine
{ my ($slf, $flg) = @_;
  my ($bld);

  $bld = get_engine($slf);
  die $slf->{'_chk'} if $slf->{'_chk'} && !$flg;
  return $bld;
}

=head2 S<$h-E<gt>find($command[,$flag])>

This method explores the path to find where a command is located. When the
command is found, it returns a full path name. Otherwise, it returns an
undefined variable. It only considers files or symbolic links in its
search. Unless the flag is set, the file path is quoted as required by a
command shell.

=cut

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

  return $slf->find_path([$slf->get_path], @arg);
}

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

This method returns the current software build.

=cut

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

  _get_version($slf) unless exists($slf->{'_bld'});
  return $slf->{'_bld'};
}

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

This method returns the screen width.

=cut

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

  return exists($slf->{'N_COLUMNS'})
    ? $slf->{'N_COLUMNS'}
    : $slf->get_system('COLUMNS', 80) - 2;
}

=head2 S<$h-E<gt>get_degree($level)>

This method resolves the setting level. It returns an undefined value when the
setting level name is unknown.

=cut

sub get_degree
{ my ($slf, $lvl) = @_;

  return unless defined($lvl);
  _get_degrees($slf) unless exists($slf->{'_lvl'});
  return
    ($lvl =~ m/^\s*(\d+)\s*$/)                ? $1 :
    exists($slf->{'_lvl'}->{$lvl = lc($lvl)}) ? $slf->{'_lvl'}->{$lvl} :
                                                undef;
}

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

This method returns the list of defined setting levels in an array context. In
a scalar context, it returns a reference to the setting level definition hash.

=cut

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

  _get_degrees($slf) unless exists($slf->{'_lvl'});
  return (sort keys(%{$slf->{'_lvl'}})) if wantarray;
  return $slf->{'_lvl'};
}

sub _get_degrees
{ my ($slf) = @_;
  my ($ifh, $tbl);

  $ifh = IO::File->new;
  $slf->{'_lvl'} = $tbl = {};
  if ($ifh->open(q{<}.get_file($slf, 'D_RDA_DAT', 'level.txt')))
  { while (<$ifh>)
    { $tbl->{lc($1)} = $2 if m/^(\w+)\s*=\s*(\d+)/;
    }
    $ifh->close;
  }
  return;
}

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

This method returns the domain name. It attempts to detect the domain name on
the first call.

=cut

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

  # When not yet known, attempt to determine the domain
  unless (defined($slf->{'_dom'}))
  { $slf->{'_dom'} =
      $slf->get_system('RDA_DOMAIN') ||
      _dsp_domain($slf) ||
      _get_domain('ipconfig /all',
        qr/(connection-specific|primary) dns suffix.*:\s*(\S+\.\S+)/i) ||
      _get_domain("nslookup $slf->{'_nod'}",
        qr/Name:\s*($slf->{'_nod'})\.(\S*)/) ||
      _get_domain('nslookup localhost', qr/Name:\s*(localhost)\.(\S*)/) ||
      _get_domain('nslookup -debug localhost', qr/(localhost)\.([^,]*),/) ||
      _get_domain('cat /etc/resolv.conf', qr/^(domain|search)\s+(\S*)/, q{});
  }

  # Return the domain name
  return $slf->{'_dom'};
}

sub _dsp_domain
{ my ($slf) = @_;
  my ($dsp);

  $dsp->dsp_line(get_string('VI_GetDomain'))
    if ($dsp = $slf->{'agt'}->is_verbose);
  return q{};
}

sub _get_domain
{ my ($cmd, $re, $val) = @_;

  local $SIG{'__WARN__'} = sub {};
  if (open(CMD, "$cmd 2>&1 |"))  ## no critic (Handle,Open)
  { while (<CMD>)
    { last if ($_ =~ $re) && ($val = $2);
    }
    close(CMD);
  }
  return $val;
}

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

This method returns the engine build.

=cut

sub get_engine
{ my ($slf) = @_;
  my ($bld, $min);

  unless (exists($slf->{'_eng'}))
  { eval {
      require RDA::Build;
      $slf->{'_eng'} = $bld = $RDA::Build::BUILD;
      eval {$slf->{'_cmp'}->{'LIB'} = [@RDA::Build::LIBRARIES]};
      eval {$slf->{'_cmp'}->{'OPR'} = [@RDA::Build::OPERATORS]};
      eval {$slf->{'_cmp'}->{'SVC'} = [@RDA::Build::SERVICES]};
      };
    if ($@)
    { $slf->{'_chk'} = get_string('NO_BUILD', $@);
      $slf->{'_eng'} = undef;
    }
    elsif ($bld lt ($min = get_build($slf)))
    { $slf->{'_chk'} = get_string('BAD_BUILD', $min);
    }
  }
  return $slf->{'_eng'};
}

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

This method returns the initial value of an environment variable or the default
value when the variable is not defined.

=cut

sub get_env
{ my ($slf, $key, $dft) = @_;

  return
    exists($slf->{'sys'}) ? $slf->{'sys'}->get_env($key,$dft) :
    exists($ENV{$key})    ? $ENV{$key} :
                            $dft;
}

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

This method indicates the current operating system family.

=head2 S<RDA::Object::Rda-E<gt>get_family($osn)>

This method indicates the family of the specified operating system. It assumes
C<Unix> for unknown operating systems.

=cut

sub get_family
{ my ($slf, $osn) = @_;

  return
    !defined($osn)        ? $slf->{'_fam'} :
    exists($tb_fam{$osn}) ? $tb_fam{$osn} :
                            'Unix';
}

=head2 S<RDA::Object::Rda-E<gt>get_gmtime([$time])>

This method returns the GMT time.

=cut

sub get_gmtime
{ my ($slf, $tim) = @_;
  my (@tim);

  @tim = gmtime(defined($tim) ? $tim : time);
  return sprintf('%02d-%3s-%04d %02d:%02d:%02d UTC',
    $tim[3], $tb_mon[$tim[4]], 1900 + $tim[5], $tim[2], $tim[1], $tim[0]);
}

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

This method returns a domain-qualified host name.

=cut

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

  return $slf->get_domain ? $slf->{'_nod'}.q{.}.$slf->{'_dom'} : $slf->{'_nod'};
}

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

This method returns the input device for Windows. Otherwise, it returns an
undefined value.

=cut

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

  unless (exists($slf->{'_con'}))
  { $slf->{'_con'} = undef;
    eval {
      require Win32::Console;
      $slf->{'_con'} = Win32::Console->new(Win32::Console::STD_INPUT_HANDLE());
    } if RDA::Object::Rda->is_windows;
  }
  return $slf->{'_con'};
}

=head2 S<RDA::Object::Rda-E<gt>get_localtime([$time])>

This method returns the local time.

=cut

sub get_localtime
{ my ($slf, $tim) = @_;
  my (@tim);

  @tim = localtime(defined($tim) ? $tim : time);
  return sprintf('%02d-%3s-%04d %02d:%02d:%02d',
      $tim[3], $tb_mon[$tim[4]], 1900 + $tim[5], $tim[2], $tim[1], $tim[0]);
}

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

This method returns the login name.

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

This method returns the node name.

=cut

sub get_node
{ return shift->{'_nod'};
}

=head2 S<$h-E<gt>get_obsolete($type)>

This method returns the list of obsolete objects from the specified type.

=cut

sub get_obsolete
{ my ($slf, $typ) = @_;

  # Load the list of obsolete objects on first request
  unless (exists($slf->{'_obs'}))
  { my ($ifh, $tbl);

    $slf->{'_obs'} = $tbl = {};
    $ifh = IO::File->new;
    if ($ifh->open('<'.get_file($slf, 'D_RDA_DAT', 'obsolete.txt')))
    { while (<$ifh>)
      { s/[\n\r\s]*$//;
        push(@{$tbl->{lc($1)}}, $_) if s/^(\w+)://;
      }
      $ifh->close;
    }
  }

  # Return the obsolete objects
  return () unless exists($slf->{'_obs'}->{$typ});
  return @{$slf->{'_obs'}->{$typ}};
}

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

This method returns the name of the operating system.

=cut

sub get_os
{ return shift->{'_osn'};
}

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

This method returns the Perl version.

=cut

sub get_perl_version
{ my ($str);

  local $SIG{'__WARN__'} = sub {};

  ## no critic (Eval,Interpolation)
  $str = eval q{sprintf('%vd', $^V)};
  $str = eval {sprintf('%d.%d.%d', $1, $2, $3) if $] =~ /(\d+)\.(\d{3})(\d+)/}
    if $@ || $str !~ m/^\d+(?:\.\d+)+$/;
  $str = '0.0.0'
    if $@ || $str !~ m/^\d+(?:\.\d+)+$/;
  return $str;
}

=head2 S<RDA::Object::Rda-E<gt>get_pid>

This method returns the current process identifier.

=cut

sub get_pid
{ return $$;
}

=head2 S<RDA::Object::Rda-E<gt>get_run>

This method returns the current run identifier.

=cut

sub get_run
{ return shift->{'ver'};
}

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

This method returns the name of the environment variables related to shared
libraries.

=cut

sub get_shlib
{ my ($slf) = @_;
  my ($lib, $osn);

  $osn = (ref($slf) && exists($slf->{'_osn'})) ? $slf->{'_osn'} : $^O;
  $lib = exists($tb_lib{$osn}) ? $tb_lib{$osn} :
         __PACKAGE__->is_unix  ? $tb_lib{'unix'} :
                                 [];
  return @{$lib} if wantarray;
  return $lib->[0];
}

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

This method returns the current value of an environment variable or the default
value when the variable is not defined.

=cut

sub get_system
{ my ($slf, $key, $dft) = @_;

  return
    exists($slf->{'sys'}) ? $slf->{'sys'}->get_value($key, $dft) :
    exists($ENV{$key})    ? $ENV{$key} :
                            $dft;
}

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

This method returns the text control object reference.

=cut

sub get_text
{ return shift->{'_txt'};
}

=head2 S<RDA::Object::Rda-E<gt>get_timestamp([$time])>

This method returns the GMT time as a time stamp string.

=cut

sub get_timestamp
{ my ($slf, $tim) = @_;
  my (@tim);

  @tim = gmtime(defined($tim) ? $tim : time);
  return sprintf('%04d%02d%02d_%02d%02d%02d',
    1900 + $tim[5], 1 + $tim[4], $tim[3], $tim[2], $tim[1], $tim[0]);
}

=head2 S<RDA::Object::Rda-E<gt>get_title($dir,$file[,$default])>

This method extracts the short description (title) from the specified file.

=cut

sub get_title
{ my ($slf, $dir, $fil, $dft) = @_;
  my ($ifh, $lin, $nxt);

  # Try to extract it from the definition file
  $ifh = IO::File->new;
  if ($ifh->open('<'.__PACKAGE__->cat_file($dir, $fil)))
  { if (defined($lin = $ifh->getline))
    { $lin =~ s/[\n\r]+$//;
      while ($lin =~ s/\\$// && defined($nxt = $ifh->getline))
      { $nxt =~ s/^#\s*//;
        $nxt =~ s/[\n\r]+$//;
        $lin .= $nxt;
      }
    }
    $ifh->close;
    return $3 if defined($lin)
      && $lin =~ m/^#\s*\Q$fil\E:\s*(E?\d{3}(\/E?\d{3})?:\s*)?(.*?)\s*$/i;
  }

  # Return the default title
  return $dft;
}

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

This method returns the names of the current time zone. In a scalar context, it
returns the standard time zone name only.

=cut

sub get_tz
{ my (@tbl);

  eval {
    require POSIX;
    ## no critic (Call)
    eval {POSIX::tzset()};
    @tbl = POSIX::tzname();
  };
  return @tbl if wantarray;
  return $tbl[0];
}

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

This method returns the user name.

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

This method returns the value of the given software configuration property. When
the property does not exist, it returns the default value.

When an array reference is provided as the name, it returns the value of the
first defined attribute from that list.

When executed in an array context, it returns the results as a list.

=cut

sub get_value
{ my ($slf, $nam, $dft) = @_;
  my ($fct, @tbl);

  $nam = [$nam] unless ref($nam);
  foreach my $key (@{$nam})
  { $key = uc($key);
    if (exists($tb_fct{$key}))
    { $fct = $tb_fct{$key};
      $dft = (ref($fct) eq 'CODE')
        ? &{$tb_fct{$key}}($slf)
        : eval "\$slf->$fct";  ## no critic (Eval)
      last;
    }
    elsif (exists($slf->{$key}))
    { $dft = $slf->{$key};
      last;
    }
  }
  if (wantarray)
  { return @{$dft} if ref($dft) eq 'ARRAY';
    return ($dft)  if defined($dft);
    return ();
  }
  return $dft;
}

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

This method returns the software version.

=cut

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

  _get_version($slf) unless exists($slf->{'_ver'});
  return $slf->{'_ver'};
}

sub _get_version
{ my ($slf) = @_;
  my ($ifh, $lin);

  $ifh = IO::File->new;
  if ($ifh->open(q{<}.get_file($slf, 'D_RDA_REL', 'rda.dat')))
  { $lin = <$ifh>;
    $ifh->close;
    if ($lin =~ m/\$Build:\s+(\d+\.\d+)-([^\$\s]+)/)
    { $slf->{'_bld'} = $2;
      $slf->{'_ver'} = $1;
      return;
    }
  }
  $slf->{'_bld'} = '000000';
  $slf->{'_ver'} = $RDA::Agent::VERSION;  ## no critic (Explicit)
  return;
}

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

This method returns the full path to the current work directory.

=cut

sub get_work
{ return shift->{'D_CWD'};
}

=head2 S<$h-E<gt>is_compiled($type)>

This method indicates whether the specified element type is compiled.

=cut

sub is_compiled
{ my ($slf, $typ) = @_;

  return unless exists($slf->{'_cmp'}->{$typ});
  return @{$slf->{'_cmp'}->{$typ}};
}

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

This method returns the current short definitions and delete them.

=cut

sub purge_shorts
{ return delete(shift->{'_sht'});
}

=head2 S<RDA::Object::Rda-E<gt>set_context($node,$domain[,$fork])>

This method loads context information and returns the domain-qualified host
name.

=cut

sub set_context
{ my ($slf, $nod, $dom, $frk) = @_;

  if (defined($frk))
  { $slf->{'B_FORK'} = $frk;
    if ($frk == 0)
    { $slf->{'_flk'} = $slf->{'_frk'} = 0
    }
    else
    { delete($slf->{'_flk'});
      delete($slf->{'_frk'});
    }
  }

  $slf->{'_nod'} = $nod if defined($nod) && length($nod);
  $slf->{'_dom'} = $dom if defined($dom) && length($dom);
  return defined($slf->{'_dom'})
    ? $slf->get_host
    : $slf->get_node;
}

=head2 S<RDA::Object::Rda-E<gt>set_domain($domain)>

This method specifies an alternative domain. It returns the previous domain
name.

=cut

sub set_domain
{ my ($slf, $dom) = @_;
  my ($old);

  $old = $slf->{'_dom'};
  $slf->{'_dom'} = $dom if defined($dom) && length($dom);
  return $old;
}

=head2 S<RDA::Object::Rda-E<gt>set_text($object)>

This method specifies an alternative text control object. It returns the
previous text control object reference.

=cut

sub set_text
{ my ($slf, $ctl) = @_;
  my ($old);

  $old = $slf->{'_txt'};
  $slf->{'_txt'} = $ctl if defined($ctl);
  return $old;
}

=head2 S<$h-E<gt>set_work($agent[,$dir])>

This method determines the work environment and changes the current directory
to it.

=cut

sub set_work
{ my ($slf, $agt, $wrk) = @_;
  my ($buf, $dir, $oid, $pth, $set);

  # Check the result set definition file
  if (defined($set = $agt->get_info('set')))
  { $pth =  __PACKAGE__->cat_file($set);

    $oid = __PACKAGE__->basename($pth);
    $dir = __PACKAGE__->dirname($pth) unless $set eq $oid;
    if ($oid =~ s/\.sub$//)
    { $slf->{'B_SUB'} = 1;
    }
    else
    { $oid =~ s/\.cfg$//;
    }
    die get_string('BAD_OID', $oid)
      unless $oid =~ m/^([A-Za-z]\w{0,31})$/;
    $agt->set_info('oid', $slf->{'oid'} = $1);
  }

  # Determine the work directory specification
  $dir = defined($wrk) ? $wrk :
         defined($dir) ? $dir :
                         $slf->get_system('RDA_CWD', q{...});

  # Resolve dynamic work directory
  $slf->{'dyn'} = ($dir =~ s{\$\$}{$$}g) ? 1 : 0;
  $slf->{'D_CWD'} = $dir = __PACKAGE__->is_path(
    ($dir eq q{...})               ? __PACKAGE__->cat_dir(getcwd()) :
    __PACKAGE__->is_absolute($dir) ? __PACKAGE__->cat_dir($dir) :
                                     __PACKAGE__->cat_dir(getcwd(), $dir));
  if ($slf->{'dyn'} && !$agt->get_info('out'))
  { $buf = "|RDA_WORK=$dir|\n";
    syswrite($RDA::Text::TRACE, $buf, length($buf));
  }

  # Change to the work directory
  chdir(__PACKAGE__->create_dir($dir, 0700))  ## no critic (Number,Zero)
    or die get_string('ERR_CD', $dir, $!);

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>uname($option)>

This method gets the name of the current operating system and returns the
information associated with one of the following options:

=over 9

=item B<    'a' > Returns all information in the following order:

=item B<    's' > Returns the system/kernel name

=item B<    'n' > Returns the network node name

=item B<    'r' > Returns the kernel release

=item B<    'v' > Returns the kernel version

=item B<    'm' > Returns the machine hardware name

=back

The meanings of the various fields are not completely standardized. The system
name might be the name of the operating system, the node name might be the
name of the host, the kernel release might be the (major) release number of
the operating system, the kernel version might be the (minor) release
number of the operating system, and the machine might be a hardware
identifier.

=cut

sub uname
{ my ($slf, $opt) = @_;

  # Get the system information
  $slf->{'_sys'} = $slf->sys_uname unless exists($slf->{'_sys'});

  # Extract the requested information
  $opt = 's' unless $opt;
  return
    ($opt eq 'a')         ? join(q{ }, @{$slf->{'_sys'}}) :
    exists($tb_sys{$opt}) ? $slf->{'_sys'}->[$tb_sys{$opt}] :
                            q{};
}

=head1 GROUP MANAGEMENT METHODS

The following groups are defined:

=over 20

=item B<    'D_CWD'>

Work directory

=item B<    'D_HOM'>

Main RDA directory (local format)

=item B<    'D_RDA'>

Main RDA directory (short format)

=item B<    'D_RDA_ADM'>

Administration directory structure

=item B<    'D_RDA_CHK'>

HCVE file directory structure

=item B<    'D_RDA_COL'>

RDA collect directory structure

=item B<    'D_RDA_CSS'>

Cascade Style Sheet directory

=item B<    'D_RDA_DAT'>

Data file directory

=item B<    'D_RDA_DFW'>

Diagnostic Framework rule repository directory

=item B<    'D_RDA_HOM'>

RDA software home directory

=item B<    'D_RDA_INC'>

Perl package directory structure

=item B<    'D_RDA_MSG'>

Message directory structure

=item B<    'D_RDA_POD'>

Perl documentation directory structure

=item B<    'D_RDA_REL'>

Release administration directory

=item B<    'D_RDA_TST'>

RDA regression test directory structure

=back

In addition, the group management methods are usable as routines by providing a
hash with the configuration as the first argument.

=head2 S<$h-E<gt>clean_group($group)>

This method retrieves a group directory and deletes its content.

=cut

sub clean_group
{ my ($slf, $grp) = @_;

  return __PACKAGE__->clean_dir(get_group($slf, $grp));
}

=head2 S<$h-E<gt>create_group($group[,$mode[,$flag]])>

This method retrieves a group directory and creates it when it does not
exist. It makes parent directories as needed. When the flag is set, it cleans
an existing directory. It returns the directory path.

=cut

sub create_group
{ my ($slf, $grp, $mod, $flg) = @_;

  return __PACKAGE__->create_dir(get_group($slf, $grp), $mod, $flg);
}

=head2 S<$h-E<gt>define_group($group[,$value])>

This method defines a group directory. When the value is not an array
reference, the group directory is deleted. It returns the previous definition.

=cut

sub define_group
{ my ($slf, $grp, $def) = @_;
  my ($old, $typ);

  if (defined($grp) && $grp =~ m/^D_RDA_[A-Z][A-Z\d]*$/)
  { $typ = $slf->{'typ'} || 'dft';
    $old = delete($tb_dir{$typ}->{$grp});
    $tb_dir{$typ}->{$grp} = $def if ref($def) eq 'ARRAY';
  }
  return $old;
}

=head2 S<$h-E<gt>delete_group($group)>

This method retrieves a group directory and deletes it.

=cut

sub delete_group
{ my ($slf, $grp) = @_;

  return __PACKAGE__->delete_dir(get_group($slf, $grp));
}

=head2 S<$h-E<gt>get_dir($group,$path)>

This method retrieves and returns the path to a directory belonging to the
specified group. Slashes (C</>) are used as delimiters when directories are
included in the path.

=cut

sub get_dir
{ my ($slf, $grp, $dir) = @_;
  my $pth;

  die get_string('BAD_GROUP', $grp)
    unless defined($pth = get_group($slf, $grp));
  return __PACKAGE__->cat_dir($pth, split(/\//, $dir));
}

=head2 S<$h-E<gt>get_file($group,$path[,$ext])>

This method retrieves and returns the path to a file belonging to the specified
group. Slashes (C</>) are used as delimiters when directories are included in
the path.

=cut

sub get_file
{ my ($slf, $grp, $nam, $ext) = @_;
  my $pth;

  die get_string('BAD_GROUP', $grp)
    unless defined($pth = get_group($slf, $grp));
  if ($ext)
  { $nam =~ s{\Q$ext\E$}{}i;
    $nam .= $ext;
  }
  return __PACKAGE__->cat_file($pth, split(/\//, $nam));
}

=head2 S<$h-E<gt>get_flag([$group])>

This method returns the value of the no-update indicator for the specified
group. When no groups are specified, it returns all flags. The indicators are
false by default.

=cut

sub get_flag
{ my ($slf, $nam) = @_;
  my ($flg, @tbl);

  # Return an individual update flag
  if (defined($nam))
  { $flg = 'B'.substr($nam, 1);
    return exists($slf->{$flg}) ? $slf->{$flg} : 0;
  }

  # Return all flags
  foreach my $grp ('B_ALTERED', sort keys(%{$tb_dir{$slf->{'typ'}}}))
  { $flg = 'B'.substr($grp, 1);
    push(@tbl, $grp, exists($slf->{$flg}) ? $slf->{$flg} : 0);
  }
  return @tbl;
}

=head2 S<$h-E<gt>get_group($group)>

This method returns the specified directory path. Relative paths are not
converted to absolute ones.

It supports also some pseudo directory names:

=over 9

=item B<    '-' > Returns a list of all defined directories

=item B<    '*' > Returns a list of all directories

=back

=cut

sub get_group
{ my ($slf, $nam) = @_;
  my ($dir, $typ);

  $typ = $slf->{'typ'} || 'dft';
  return (grep {m/^D_RDA_/} sort keys(%{$slf})) if $nam eq q{-};
  return (sort keys(%{$tb_dir{$typ}}))          if $nam eq q{*};
  $dir = exists($slf->{$nam})
           ? $slf->{$nam} :
         exists($tb_dir{$typ}->{$nam})
           ? __PACKAGE__->cat_dir(@{$tb_dir{$typ}->{$nam}}) :
         undef;
  return (defined($dir) && $nam =~ m/^D/ && exists($slf->{'D_RDA'})
    && !__PACKAGE__->is_absolute($dir))
    ? __PACKAGE__->cat_dir($slf->{'D_RDA'}, $dir)
    :$dir;
}

=head1 DIRECTORY AND FILE MANAGEMENT METHODS

=head2 S<RDA::Object::Rda-E<gt>arg_dir([$dir...,]$dir)>

This method performs a C<cat_dir> and quotes the result only for Windows.

=head2 S<RDA::Object::Rda-E<gt>arg_file([$dir...,]$file)>

This method performs a C<cat_file> and quotes the result only for Windows.

=head2 S<RDA::Object::Rda-E<gt>as_bat([$path])>

This method adds script-specific extension to the specified path.

=head2 S<RDA::Object::Rda-E<gt>as_cmd([$path])>

This method adds script-specific extension to the specified path.

=head2 S<RDA::Object::Rda-E<gt>as_exe([$path])>

This method adds executable-specific extension to the specified path.

=head2 S<RDA::Object::Rda-E<gt>basename($file[,@suf])>

This method extracts the base name of the file specification and  removes the
suffix when it belongs to the suffix list. It matches each element of this list
as a string against the end of the name.

When treating existing files from systems that are not case-sensitive, the
pattern matching for suffix removal ignores case.

=head2 S<RDA::Object::Rda-E<gt>can_spawn>

This method indicates whether it is possible to launch background processes.

=head2 S<RDA::Object::Rda-E<gt>cat_dir([$dir...,]$dir)>

This method concatenates directory names to form a complete path ending with a
directory. It removes the trailing slash from the resulting string, except for
the root directory.

It discards undefined values and references from the argument list.

=head2 S<RDA::Object::Rda-E<gt>cat_file([$dir...,]$file)>

This method concatenates directory names and a file name to form a complete
path ending with a file name.

It discards undefined values and references from the argument list.

=head2 S<RDA::Object::Rda-E<gt>cat_native([$dir...,]$file)>

This method concatenates directory names and a file name to form a complete
native path ending with a file name.

It discards undefined values and references from the argument list.

=head2 S<RDA::Object::Rda-E<gt>clean_dir($path)>

This method deletes the content of a directory but not the directory itself. It
returns the directory path.

=head2 S<RDA::Object::Rda-E<gt>clean_native($path[,$flag])>

This method performs a logical cleanup of a path. When the flag is set, it
performs additional platform-specific simplifications. It returns a native
path.

=head2 S<RDA::Object::Rda-E<gt>clean_path($path[,$flag])>

This method performs a logical cleanup of a path. When the flag is set, it
performs additional platform-specific simplifications.

=head2 S<RDA::Object::Rda-E<gt>create_dir($path[,$mode[,$flag]])>

This method creates a directory when it does not yet exist. It makes parent
directories as needed. If directory permissions are omitted, 0750 is used as
default. When the flag is set, it cleans an existing directory. It returns the
directory path.

=head2 S<RDA::Object::Rda-E<gt>current_dir>

This method returns a string representation of the current directory (C<.> for
UNIX).

=head2 S<RDA::Object::Rda-E<gt>delete_dir($path)>

This method deletes a directory and its content.

=head2 S<RDA::Object::Rda-E<gt>dev_null>

This method returns a string representation of the null device.

=head2 S<RDA::Object::Rda-E<gt>dev_tty>

This method returns a string representation of the terminal device.

=head2 S<RDA::Object::Rda-E<gt>dirname($file)>

This method returns the directory portion of the input file specification.

=head2 S<RDA::Object::Rda-E<gt>get_last_modify($file[,$default])>

This method gets the last modification date of the file. It returns the default
value when there are problems.

=head2 S<RDA::Object::Rda-E<gt>get_path>

This method returns the C<PATH> environment variable as a list.

=head2 S<RDA::Object::Rda-E<gt>get_separator>

This method returns the character used as the separator.

=head2 S<RDA::Object::Rda-E<gt>has_short>

This method indicates whether the files and directories can have short names.

=head2 S<RDA::Object::Rda-E<gt>is_absolute($path)>

This method indicates whether or not the argument is an absolute path.

=head2 S<RDA::Object::Rda-E<gt>is_cygwin>

This method returns a true value when the operating system is Cygwin.

=head2 S<RDA::Object::Rda-E<gt>is_path($string)>

This method verifies that the string does not contain characters invalid in a
path.

=head2 S<RDA::Object::Rda-E<gt>is_root_dir($path)>

This method indicates whether or not the path represents a root directory. It
assumes that the provided path is already cleaned.

=head2 S<RDA::Object::Rda-E<gt>is_unix>

This method returns a true value when the operating system belongs to the UNIX
family.

=head2 S<RDA::Object::Rda-E<gt>is_vms>

This method returns a true value when the operating system is VMS.

=head2 S<RDA::Object::Rda-E<gt>is_windows>

This method returns a true value when the operating system belongs to the
Windows family.

=head2 S<RDA::Object::Rda-E<gt>kill_child($pid)>

This method kills a child process.

=head2 S<RDA::Object::Rda-E<gt>native($path)>

This method converts the path to its native representation. It does not make
any transformation for UNIX.

=head2 S<RDA::Object::Rda-E<gt>parse_path($path[,@suf])>

This method divides a file path into the directories, its file name, and
optionally the file suffix. The directory part contains everything up to and
including the last directory separator in the C<$path> including the volume,
when applicable. The remainder of the path is the file name.

=head2 S<RDA::Object::Rda-E<gt>quote($string[,$flag])>

This method encodes a string to be considered as a single argument by a command
shell. Unless the flag is set, variable substitution is disabled.

=head2 S<RDA::Object::Rda-E<gt>quote2($string[,$flag])>

This method is similar to the C<quote> method but the result does not contain
the leading and trailing quotation marks.

=head2 S<RDA::Object::Rda-E<gt>re($str)>

This method converts a string containing wild cards into a Perl regular
expression.

=head2 S<RDA::Object::Rda-E<gt>short($path)>

This method converts the path to its native representation using only short
names. It does not make any transformation for UNIX.

=head2 S<RDA::Object::Rda-E<gt>split_dir($path)>

This method returns the list of directories contained in the specified
path. Unlike just splitting the directories on the separator, empty directory
names (C<''>) can be returned, because these are significant on some operating
systems. The first element can contain volume information.

For UNIX,

    RDA::Object::Rda->split_dir("/a/b//c/");

Yields:

    ('', 'a', 'b', '', 'c', '')

=head2 S<RDA::Object::Rda-E<gt>split_volume($path)>

This method separates the volume from the other path information.

=head2 S<RDA::Object::Rda-E<gt>unquote($string)>

This method removes the quoting characters from a string.

=head2 S<RDA::Object::Rda-E<gt>up_dir>

This method returns a string representation of the parent directory (C<..> for
UNIX).

=cut

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Build|RDA::Build>,
L<RDA::Local::Cygwin|RDA::Local::Cygwin>,
L<RDA::Local::Unix|RDA::Local::Unix>,
L<RDA::Local::Vms|RDA::Local::Vms>,
L<RDA::Local::Windows|RDA::Local::Windows>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Display|RDA::Object::Display>,
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