# XPLRlib.ctl: Defines Common Explorer Macros
# $Id: XPLRlib.ctl,v 1.21 2015/08/21 15:40:48 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/collect/EXPLORER/XPLRlib.ctl,v 1.21 2015/08/21 15:40:48 RDA Exp $
#
# Change History
# 20150821  MSC  Improve time consistency.

=head1 NAME

EXPLORER:XPLRlib - Defines Common Explorer Macros

=head1 DESCRIPTION

This persistent submodule regroups macros that are common to Explorer modules.

The following macros are available:

=cut

use Buffer,Explorer

# Make the module persistent and share macros
keep $KEEP_BLOCK,@SHARE_MACROS,@RESET_MACROS
var @SHARE_MACROS = ('check_patch',\
  'do_collect_dir','do_collect_fil','do_collect_rem','do_collect_sel',\
  'do_command','do_exec','do_remote',\
  'get_arc','get_bin_tool','get_ips_base','get_ips_version',\
  'get_modified_files','get_osv','get_pkg_base','get_pkg_version',\
  'get_solaris_version','get_sub','get_tmp','get_zones',\
  'has_zones',\
  'is_explicit','is_ips_installed','is_pkg_installed','is_rejected',\
  'log_critical','log_error','log_exec','log_info','log_missing',\
  'log_restricted','log_run','log_warning')
var @RESET_MACROS = @SHARE_MACROS

# Initialisation
var ($MOD) = @arg

var $ERR = '---## Associated Errors'
var $PID = ${RUN.EXPLORER.N_PID}
var $PRE = "   \001"
keep $MOD,$PID,$PRE

=head2 S<check_patch($num,$rev[,$pkg[,$flg]])>

This macro indicates whether the specified patch is installed and has the
minimal revision. When the flag is set, it requires that the specified
revision is installed and not obsoleted.

=cut

macro check_patch
{var ($num,$rev,$pkg,$flg) = @arg

 # Check if a patch is requested
 if !?$num
  return true

 # Check if an adequate patch is installed
 var $mod = cond(isUnix(),'x','f')
 if ?nvl(testFile($mod,'/usr/bin/showrev'),\
         testFile($mod,'/usr/sbin/patchadd'))
 {$cmd = concat(last,' -p')
  # Looking for exact match
  if $flg
  {var $ret = false
   loop $lin (caller:grepCommand($cmd,\
     concat('\b',$num,cond(defined($pkg),list('\-.*\b',$pkg,'\b'),'\-'))))
   {var $lin = replace($lin,'Requires:.*$')
    if match($lin,concat('Obsoletes:.*\b',$num,'\-(\d+)\b'))
    {if expr('>=',last,$rev)
      return false
    }
    elsif match($lin,concat('Patch:\s*',$num,'\-(\d+)\s'))
    {var ($cur) = last
     if expr('>',$cur,$rev)
      return false
     if expr('==',$cur,$rev)
      var $ret = true
    }
   }
   return $ret
  }

  # For non-exact match, search in 'Patch' and 'Obsoletes' sections
  loop $lin (caller:grepCommand($cmd,\
    concat('\b',$num,cond(defined($pkg),list('\-.*\b',$pkg,'\b'),'\-'))))
  {var $lin = replace($lin,'Requires:.*$')
   var ($cur) = match($lin,concat('\b',$num,'-(\d+)\b'))
   if expr('>=',$cur,$rev)
    return true
  }
 }
 return false
}

=head2 S<do_collect_dir($pre,$dir[,$flg])>

This macro collects text files from the specified directory. When the flag is
set, it collects files recursively in sub directories.

=cut

macro do_collect_dir
{var ($pre,$dir,$flg) = @arg

 loop $fil (grepDir([$dir],'^\.+$',cond($flg,'drv','nv')))
 {if ?testFile('fT',$pth = catFile($dir,$fil))
  {if collectFile(join('/',$pre,$fil),$pth)
   {write '|[[../',last,'][_blank][',encode($pth),']] | ',getSize($pth),'|',\
          getLastModify($pth,'<UTC>'),' |'
    next
   }
  }
  if !?testFile('d',$pth)
   write '|',encode($pth),' | ',getSize($pth),'|',\
         getLastModify($pth,'<UTC>'),' |'
 }
}

=head2 S<do_collect_fil(@rec)>

This macro collects a list of files. Each argument is either a text, a command
descriptor, or an array reference containing the Explorer report name, the full
path of the file to collect, an optional binary file indicator, an optional
link text, an optional pattern, and optional search option.

=cut

macro do_collect_fil
{loop $rec (@arg)
 {var $ref = ref($rec)
  if !$ref
   write $rec
  elsif compare('eq',$ref,'HASH')
   call caller:do_command($rec,undef,undef,'/')
  elsif defined($rec->[4])
   call do_collect_sel($rec->[0],$rec->[1],$rec->[4],$rec->[5],$rec->[6])
  elsif ?testDir('d',$rec->[1])
   call do_collect_dir($rec->[0],$rec->[1],$rec->[2])
  else
  {if ?testFile(cond($rec->[2],'f','fT'),$rec->[1])
   {if cond($rec->[2],collectData($rec->[0],$rec->[1]),\
                      collectFile($rec->[0],$rec->[1]))
    {write '|[[../',last,'][_blank][',nvl($rec->[3],encode($rec->[1])),']] | ',\
           getSize($rec->[1]),'|',getLastModify($rec->[1],'<UTC>'),' |'
     next
    }
   }
   if ?testFile('e',$rec->[1])
    write '|',nvl($rec->[3],encode($rec->[1])),' | ',getSize($rec->[1]),'|',\
          getLastModify($rec->[1],'<UTC>'),' |'
  }
 }
}

=head2 S<do_collect_rem($pre,$top,@rec)>

This macro collects a list of files. Each argument is either a text, a command
descriptor,an array reference containing the scope, the Explorer report name,
the full path of the file to collect, an optional binary file indicator, an
optional link text, an optional pattern, and optional search option.

Valid scopes are C<G> for the global zone, C<L> for the local zones, and C<B>
for both.

=cut

macro do_collect_rem
{var ($pre,$top,@fil) = @arg

 loop $rec (@fil)
 {var $ref = ref($rec)
  if !$ref
   write $rec
  elsif compare('eq',$ref,'HASH')
   call caller:do_command($rec,$pre,undef,$top)
  elsif compare('eq',$rec->[0],cond(defined($pre),'G','L'))
   next
  elsif defined($rec->[5])
   call do_collect_sel(join('/',$pre,$rec->[1]),catDir($top,$rec->[2]),\
                       $rec->[5],$rec->[6],$rec->[7])
  elsif ?testDir('d',catDir($top,$rec->[2]))
   call do_collect_dir(join('/',$pre,$rec->[1]),lastDir(),$rec->[3])
  else
  {if ?testFile(cond($rec->[3],'f','fT'),$pth = catFile($top,$rec->[2]))
   {if cond($rec->[3],collectData(join('/',$pre,$rec->[1]),$pth),\
                      collectFile(join('/',$pre,$rec->[1]),$pth))
    {write '|[[../',last,'][_blank][',nvl($rec->[4],encode($pth)),']] | ',\
           getSize($pth),'|',\
           getLastModify($pth,'<UTC>'),' |'
     next
    }
   }
   if ?testFile('e',$pth)
    write '|',nvl($rec->[4],encode($pth)),' | ',getSize($pth),'|',\
          getLastModify($pth,'<UTC>'),' |'
  }
 }
}

=head2 S<do_collect_sel($pre,$dir,$pat[,$opt])>

This macro collects all files matching the specified pattern in the specified
directory. You can specify search options as an extra argument.

=cut

macro do_collect_sel
{var ($pre,$dir,$pat,$opt,$idx) = @arg

 loop $fil (grepDir([$dir],$pat,nvl($opt,'n')))
 {if ?testDir('fT',$pth = catFile($dir,$fil))
  {if collectFile(join('/',$pre,$fil),$pth,$idx)
   {write '|[[../',last,'][_blank][',encode($pth),']] | ',getSize($pth),'|',\
          getLastModify($pth,'<UTC>'),' |'
    next
   }
  }
  if !?testFile('d',$pth)
   write '|',encode($pth),' | ',getSize($pth),'|',\
         getLastModify($pth,'<UTC>'),' |'
 }
}

=head2 S<do_command($rec[,$pre,$cmd,$top])>

This macro executes one command. Its definition hash can contain the following
keys:

=over 11

=item S<    B<'buf'> > Specifies the buffer reference.

=item S<    B<'cat'> > Specifies the catalog entry type.

=item S<    B<'cfm'> > Specifies the customer file management level.

=item S<    B<'cmd'> > Specifies the command.

=item S<    B<'cnt'> > Specifies the associated count.

=item S<    B<'cod'> > Specifies the associated code.

=item S<    B<'det'> > Specifies the section title details.

=item S<    B<'fil'> > Specifies the source file.

=item S<    B<'idx'> > Specifies an index entry.

=item S<    B<'key'> > Specifies the sorting criteria.

=item S<    B<'max'> > Specifies the number of the last line to include.

=item S<    B<'min'> > Specifies the number of the first line to include.

=item S<    B<'nam'> > Specifies the name of the Explorer target.

=item S<    B<'src'> > Specifies the name of the source for links.

=item S<    B<'tag'> > Associates the tag list to the block.

=item S<    B<'tbl'> > Specifies the table reference.

=item S<    B<'ttl'> > Specifies the section title.

=item S<    B<'txt'> > Specifies the associated text.

=back

It supports the following commands:

=over 15

=item S<    B<'ARRAY'>>

Uses the C<cat>, C<det>, C<nam>, C<tbl>, and C<ttl> keys.

=item S<    B<'BEGIN'>>

Uses the C<cnt>, C<fil>, and C<nam> keys.

=item S<    B<'BUFFER'>>

Uses the C<buf>, C<cat>, C<det>, C<max>, C<min>, C<nam>, and C<ttl> keys.

=item S<    B<'CODE'>>

Uses the C<cod> key.

=item S<    B<'COMMENT'>>

Uses the C<nam> and C<txt> keys.

=item S<    B<'END'>>

Uses the C<cnt>, C<fil>, and C<nam> keys.

=item S<    B<'HASH'>>

Uses the C<cat>, C<det>, C<key>, C<nam>, C<tbl>, and C<ttl> keys.

=item S<    B<'HEAD'>>

Uses the C<cnt>, C<fil>, and C<nam> keys.

=item S<    B<'LN'>>

Uses the C<nam> and C<src> keys.

=item S<    B<'SLEEP'>>

Uses the C<cnt> key.

=item S<    B<'TAIL'>>

Uses the C<cnt>, C<fil>, and C<nam> keys.

=item S<    B<'TITLE'>>

Uses the C<txt> key.

=item S<    B<'UNTITLE'>>

Uses the C<cnt> key.

=back

=cut

macro do_command
{var ($rec,$pre,$exe,$top) = @arg
 import $TOP
 keep $TOP

 var $cmd = $rec->{'cmd'}
 if compare('eq',$cmd,'ARRAY')
 {if exists($rec->{'tbl'})
  {var \@tbl = $rec->{'tbl'}
   prefix
   {if exists($rec->{'ttl'})
     write $rec->{'ttl'}
    if exists($rec->{'det'})
     write '---## Using: ',$rec->{'det'}
    if exists($rec->{'nam'})
     call addBlock('E',nvl($rec->{'cat'},'O'),join('/',$pre,$rec->{'nam'}))
    if exists($rec->{'cfm'})
     call addBlock('L',$rec->{'cfm'})
    if exists($rec->{'tag'})
     call addBlock('T',$rec->{'tag'})
    call beginBlock(true)
   }
   loop $lin (@tbl)
    write $lin
   if hasOutput(true)
   {call endBlock($rec->{'idx'})
    write $TOP
   }
  }
 }
 elsif or($flg = compare('eq',$cmd,'BEGIN'),compare('eq',$cmd,'END'))
 {if ?testFile('fT',$pth = catFile($top,$rec->{'fil'}))
  {var ($cnt,$nam) = ($rec->{'cnt'},join('/',$pre,$rec->{'nam'}))
   var ($typ,$dsc) = cond($flg,list('h','First '),\
                               list('t','Last '))
   if $buf = new('Buffer',$typ,$pth,$cnt)
   {var $lnk = encode($pth)
    var $siz = getSize($pth)
    if $buf->is_complete
     var ($typ,$dsc) = ('F',concat(' ',$siz))
    else
     var $dsc = concat($dsc,$cnt,' bytes ')
    if $siz
    {var $rpt = $[OUT]->add_report('d',$nam,0,'.lin')
     if $rpt->write_data($buf,['F',$pth,uc($typ),'D'],\
          ['E','B',$nam],['L',$rec->{'cfm'}],['T',$rec->{'tag'}])
      var $lnk = concat('[[',$rpt->get_raw(true),'][_blank][',$lnk,']]')
     call $[OUT]->end_report($rpt)
    }
    write '|',$lnk,' |',$dsc,'|',getLastModify($pth,'<UTC>'),' |'
   }
  }
  elsif ?testFile('e',$pth)
    write '|',encode($pth),' | ',getSize($pth),'|',\
          getLastModify($pth,'<UTC>'),' |'
 }
 elsif compare('eq',$cmd,'BUFFER')
 {if exists($rec->{'buf'})
  {prefix
   {if exists($rec->{'ttl'})
     write $rec->{'ttl'}
    if exists($rec->{'det'})
     write '---## Using: ',$rec->{'det'}
    if exists($rec->{'nam'})
     call addBlock('E',nvl($rec->{'cat'},'O'),join('/',$pre,$rec->{'nam'}))
    if exists($rec->{'cfm'})
     call addBlock('L',$rec->{'cfm'})
    if exists($rec->{'tag'})
     call addBlock('T',$rec->{'tag'})
   }
   call writeLines($rec->{'buf'},$rec->{'min'},$rec->{'max'},$rec->{'idx'})
   if hasOutput(true)
    write $TOP
  }
 }
 elsif compare('eq',$cmd,'CODE')
  call eval($rec->{'cod'})
 elsif compare('eq',$cmd,'COMMENT')
 {call addBlock('E','T',join('/',$pre,$rec->{'nam'}))
  call addBlock('L',nvl($rec->{'cfm'},1))
  if exists($rec->{'tag'})
   call addBlock('T',$rec->{'tag'})
  call writeComment($rec->{'txt'})
 }
 elsif compare('eq',$cmd,'HASH')
 {if exists($rec->{'tbl'})
  {var \%tbl = $rec->{'tbl'}
   prefix
   {if exists($rec->{'ttl'})
     write $rec->{'ttl'}
    if exists($rec->{'det'})
     write '---## Using: ',$rec->{'det'}
    if exists($rec->{'nam'})
     call addBlock('E',nvl($rec->{'cat'},'O'),join('/',$pre,$rec->{'nam'}))
    if exists($rec->{'cfm'})
     call addBlock('L',$rec->{'cfm'})
    if exists($rec->{'tag'})
     call addBlock('T',$rec->{'tag'})
    call beginBlock(true)
   }
   loop $key (keys(%tbl,nvl($rec->{'key'},'KA')))
    write $tbl{$key}
   if hasOutput(true)
   {call endBlock()
    write $TOP
   }
  }
 }
 elsif or($flg = compare('eq',$cmd,'HEAD'),compare('eq',$cmd,'TAIL'))
 {if ?testFile('fT',$pth = catFile($top,$rec->{'fil'}))
  {var ($cnt,$nam) = ($rec->{'cnt'},join('/',$pre,$rec->{'nam'}))
   if $buf = new('Buffer','r',$pth)
   {var $lnk = encode($pth)
    if getSize($pth)
    {var $rpt = $[OUT]->add_report('d',$nam,0,'.lin')
     if cond($flg,\
             $rpt->write_lines($buf,1,$cnt,['F',$pth,'','T'],\
               ['E','D',$nam],['L',$rec->{'cfm'}],['T',$rec->{'tag'}]),\
             $rpt->write_tail($buf,$cnt,['F',$pth,'F','T'],\
               ['E','D',$nam],['L',$rec->{'cfm'}],['T',$rec->{'tag'}]))
      var $lnk = concat('[[',$rpt->get_raw(true),'][_blank][',$lnk,']]')
     call $[OUT]->end_report($rpt)
    }
    write '|',$lnk,' |',cond($flg,'First ','Last '),$cnt,' lines |',\
          getLastModify($pth,'<UTC>'),' |'
   }
  }
  elsif ?testFile('e',$pth)
   write '|',encode($pth),' | ',getSize($pth),'|',\
          getLastModify($pth,'<UTC>'),' |'
 }
 elsif compare('eq',$cmd,'LN')
 {call addEntry('E','L',$rec->{'nam'},$rec->{'src'})
  call beginBlock()
  call endBlock()
 }
 elsif compare('eq',$cmd,'SLEEP')
  sleep $rec->{'cnt'}
 elsif compare('eq',$cmd,'TITLE')
  title $rec->{'txt'}
 elsif compare('eq',$cmd,'UNTITLE')
  untitle nvl($rec->{'cnt'},1)
}

=head2 S<do_exec(@rec)>

This macro executes a list of commands. Each argument is either a text, a
command descriptor, an array reference, or a hash reference. An array contains
the Explorer report name, the full path of the command to execute, the command
argument, the corresponding title, and an optional extension suppression
indicator. A hash is treated by the C<do_command> macro.

=cut

macro do_exec
 call caller:do_remote(undef,undef,'/',@arg)

=head2 S<do_remote($pre,$cmd,$top,@rec)>

This macro executes a list of commands on a remote system. Each argument is
either a text, a command descriptor, an array reference, or a hash
reference. The array contains the Explorer report name, the command to execute,
the corresponding title, and an optional extension suppression indicator. A
hash is treated by the C<do_command> macro.

It prefixes all report names and commands respectively by the first and second
arguments.

=cut

macro do_remote
{var ($pre,$exe,$top,@rec) = @arg
 import $ERR,$TOP
 keep $ERR,$TOP

 loop $rec (@rec)
 {var $ref = ref($rec)
  if !$ref
   write $rec
  elsif compare('eq',$ref,'HASH')
   call caller:do_command($rec,$pre,$exe,$top)
  elsif !?$rec->[1]
  {write $rec->[3]
   call beginBlock(true)
   call addBlock('E','O',join('/',$pre,$rec->[0]))
   write $rec->[2]
   call endBlock()
   write $TOP
  }
  elsif !isAbsolute($rec->[1])
   call log_missing($rec->[1])
  elsif !?testFile('f',catFile($top,$rec->[1]))
   call log_missing(lastFile())
  elsif hasRestriction($rec->[1])
   call log_restricted($rec->[1])
  elsif !?testFile(cond(isUnix(),'x','f'),lastFile())
   call log_exec(lastFile())
  else
  {var $cmd = join(' ',quote($rec->[1]),$rec->[2])
   if ?$exe
    var $cmd = join(' ',$exe,quote($cmd))
   if compare('eq',ref($dsc = $rec->[4]),'HASH')
   {prefix
    {write $rec->[3]
     write '---## Using: ',nvl($dsc->{'det'},encode($cmd))
    }
    if exists($dsc->{'nul'})
    {var $dsc = {%{$dsc->{'nul'}}}
     call addBlock('E',cond(exists($dsc->{'cat'}),$dsc->{'cat'},'O'),\
       concat($rec->[0],cond(exists($dsc->{'ext'}),$dsc->{'ext'},'.out')))
     call caller:writeCommand(concat($cmd,' 2>/dev/null'))
    }
    else
     call caller:collectCommand({nam=>join('/',$pre,$rec->[0]),\
       cond(exists($dsc->{'req'}),%{$dsc->{'req'}},list()),\
       out=>{blk=>true,flt=>true,idx=>true,kpt=>true,rpt=>${CUR.O_REPORT},\
             cond(exists($dsc->{'out'}),%{$dsc->{'out'}},list())},\
       err=>{blk=>true,flt=>true,hdr=>$ERR,rpt=>${CUR.O_REPORT},\
             cond(exists($dsc->{'err'}),%{$dsc->{'err'}},list())}\
       },$cmd)
   }
   else
   {prefix
    {write $rec->[3]
     write '---## Using: ',encode($cmd)
    }
    call caller:collectCommand({nam=>join('/',$pre,$rec->[0]),\
      out=>{blk=>true,flt=>true,idx=>true,kpt=>true,rpt=>${CUR.O_REPORT},\
            cond(ref($rec->[4]),%{$rec->[4]},$rec->[4],list(ext=>''),list())},\
      err=>{blk=>true,flt=>true,hdr=>$ERR,rpt=>${CUR.O_REPORT}}\
      },$cmd)
   }
   if hasOutput(true)
    write $TOP
  }
 }
}

=head2 S<get_modified_files($beg,$end,$dir,$pat[,$opt])>

This macro lists all files from the specified directory that are matching the
specified criteria. You can restrict the file selection by specifying a time
interval for the last modification date/time of the file. The lower limit is
included in the interval but not the upper limit. The end time does not apply
to circular files.

=cut

macro get_modified_files
{var ($beg,$end,$dir,$pat,$opt) = @arg
 var @fil = ()

 loop $fil (grepDir([$dir],$pat,nvl($opt,'n')))
 {if ?testDir('f',catFile($dir,$fil))
  {if and($beg,$end)
   {var $tim = getLastModify(lastFile())
    next expr('<',$tim,$beg)
    if !match($fil,'(console|messages(\.remote)?|(err|sys)log)$')
     next expr('>=',$tim,$end)
   }
   call push(@fil,$fil)
  }
 }
 return @fil
}

=head1 SYSTEM-RELATED MACROS

=head2 S<get_arc()>

This macro returns the system architecture. Typical values for Solaris are
C<i386> and C<sparc>.

=cut

macro get_arc
{if ?${RUN.EXPLORER.W_ARC}
  return last
 var ($val) = \
   caller:grepCommand([${CMD.UNAME:'uname'},' -p'],'^([\w\-]+)','f1')
 if compare('eq',$val,'unknown')
  var $val = uname('m')
 return ${RUN.EXPLORER.W_ARC} = $val
}

=head2 S<get_bin_tool($name)>

This macro returns the path to a tool present in the Explorer F<bin> directory
structure.

=cut

macro get_bin_tool
{var ($nam,$flg) = @arg

 macro extract_top_dir
 {if ?readLink(@arg)
   return $[RDA]->clean_path(catDir(dirname(last),upDir()),true)
  return undef
 }

 var $top = nvl(\
   ${RUN.EXPLORER.D_TOP},\
   caller:get_ips_base('support/explorer','^(.*/explorer)/bin/explorer'),\
   caller:get_pkg_base('SUNWexplo','SUNWexplo'),\
   extract_top_dir('/usr/sbin/explorer'),\
   getGroupDir('D_RDA','../explorer'))
 if ?$dir = nvl(testFile('d',catDir($top,'bin')),\
                testFile('d',catDir($top = '/usr/lib/explorer','bin')),\
                testFile('d',catDir($top = '/opt/SUNWexplo','bin')))
 {var $sub = catDir($dir,get_sub())
  loop $cmd ('/usr/bin/isainfo','/usr/bin/isalist')
  {if ?testFile('fx',$cmd)
   {loop $arc (split('\s+',caller:command(concat($cmd,' 2>/dev/null'))))
    {next match($arc,'\W')
     if ?testFile('fx',catFile($sub,$arc,$nam))
      return cond($flg,list(last,$top),last)
    }
   }
  }
  if ?nvl(testFile('fx',catFile($sub,get_arc(),$nam)),\
          testFile('fx',catFile($sub,$nam)),\
          testFile('fx',catFile($dir,$nam)))
   return cond($flg,list(last,$top),last)
 }
 return undef
}

=head2 S<get_osv()>

This macro returns the second part of the operating system version.

=cut

macro get_osv
{if ?${RUN.EXPLORER.N_OSV}
  return last
 return ${RUN.EXPLORER.N_OSV} = field('\.',1,uname('r'))
}

=head2 S<get_solaris_version([$zone])>

This macro returns the version of Solaris running in the specified zone. When
you do not specify a zone name as an argument, it returns the version running
on the global zone. The version includes the update number for Solaris 11 and
later. It returns an undefined value for other operating systems.

=cut

macro get_solaris_version
{keep %cch

 if ?$arg[0]
  var $exe = concat('/usr/sbin/zlogin ',$zon = last)
 else
  var ($zon, $exe) = ('global')

 if exists($cch{$zon})
  return $cch{$zon}
 if !${OS.solaris}
  return $cch{$zon} = undef
 var ($ver) = \
   caller:grepCommand(join(' ',$exe,'/usr/bin/uname -r'),'^(\d\.\d+)','f1')
 if !compare('valid',$ver,'5.11')
  return $cch{$zon} = $ver
 return $cch{$zon} = join('.',$ver,\
   caller:grepCommand(join(' ',$exe,'/usr/bin/uname -v'),'^\d+\.(.+)$','f1'))
}

=head2 S<get_sub()>

This macro returns the operating system-specific sub directory.

=cut

macro get_sub
{if ?${RUN.EXPLORER.W_SUB}
  return last
 return ${RUN.EXPLORER.W_SUB} = check(${RDA.T_OS},'solaris','solaris',\
                                                  'linux',  'linux',\
                                                  'cygwin', 'cygwin',\
                                                            undef)
}

=head2 S<get_tmp()>

This macro returns the path to the secure temporary directory.

=cut

macro get_tmp
{if ?${RUN.EXPLORER.D_TMP}
  return last
 return ${OUT.T}
}

=head2 S<get_zones([$default])>

This macro returns a list of zone descriptors, controlled by the C<B_GLOBAL>,
C<B_LOCAL>, and C<T_ZONES> settings. Each descriptor is an array reference
containing the zone name, the zone root directory, the operating system
version, and the zone status.

When present, the global zone descriptor is the first descriptor of the list
and has an undefined value as name and as status.

You can specify the default value of the C<B_LOCAL> setting as an argument.

=cut

# Build the list of zones to treat
macro get_zones
{var ($dft) = @arg
 var @zon = ()

 # Identify the relevant local zones
 if ${B_LOCAL:$dft}
 {# Check for zone restrictions
  if @{T_ZONES}
  {loop $nam (last)
    var $tbl->{$nam} = 1
  }

  # Find the local zones
  loop $val(caller:grepCommand('/usr/sbin/zoneadm list -p',\
                               '^[^:]*:global:','v'))
  {var (undef,$nam,$sta,$top) = split(':',$val)
   next !match($nam,'^([A-Za-z0-9][\w\-\.]{0,63})$')
   var $nam = first
   next and(defined($tbl),missing($tbl->{$nam}))
   if ?testDir('d',$top)
    call push(@zon,\
      [$nam,catDir(last,'root'),caller:get_solaris_version($nam),$sta])
  }
 }

 # Add the global zone as first element unless requested to skip it.
 if ${B_GLOBAL:true}
  call unshift(@zon,[undef,'/',caller:get_solaris_version()])

 # Return the list of zones
 return @zon
}

=head2 S<has_zones()>

This macro indicates whether the current system can have zones.

=cut

macro has_zones
 return and(${OS.solaris},expr('>=',get_osv(),10))

=head2 S<is_explicit()>

This macro indicates whether the module has been set explicitly.

=cut

macro is_explicit
{import $MOD
 keep $MOD

 return grep(@{W_EXPLICIT:@{W_MODULES}},concat('^',$MOD,'$'),'f')
}

=head2 S<is_rejected($mod)>

This macro indicates whether the specified module has been rejected.

=cut

macro is_rejected
 return grep(@{W_REJECTED},concat('^',$arg[0],'$'),'f')

=head1 PACKAGE-RELATED MACROS

=head2 S<get_ips_base($pkg,$pat)>

This macro returns the installation base for the specified IPS package. It
requires a pattern to extract the directory from the package content. For
example,

  get_ips_base('support/explorer','^(.*usr/lib)/bin/explorer')

=cut

macro get_ips_base
{var ($pkg,$pat) = @arg
 if caller:grepCommand(concat('/usr/bin/pkg contents ',$pkg,' 2>/dev/null'),\
                       $pat,'f1')
  return testDir('d',catDir('',last))
 return undef
}

=head2 S<get_ips_version($pkg)>

This macro returns the version of the specified IPS package.

=cut

macro get_ips_version
{var ($pkg) = @arg
 var ($ver) = caller:grepCommand(\
   concat('/usr/bin/pkg info -l ',$pkg,' 2>/dev/null'),\
   'Version:\s*(\d+(\.\d+)+)','f1')
 return $ver
}

=head2 S<get_pkg_base($pkg[,@sub])>

This macro returns the installation base for the specified SRV4 package. You
can specify extra arguments to return a subdirectory.

=cut

macro get_pkg_base
{var ($pkg,@sub) = @arg
 if caller:grepCommand(concat('/usr/bin/pkginfo -r ',$pkg,' 2>/dev/null'),\
                       '^\/','f')
  return testDir('d',catDir(last,@sub))
 return undef
}

=head2 S<get_pkg_version($pkg)>

This macro returns the version of the specified SVR4 package.

=cut

macro get_pkg_version
{var ($pkg) = @arg
 var ($ver) = caller:grepCommand(\
   concat('/usr/bin/pkginfo -l ',$pkg,' 2>/dev/null'),\
   'VERSION:\s*(\d+(\.\d+)+)','f1')
 return $ver
}

=head2 S<is_ips_installed($pkg)>

This macro indicates whether the specified IPS package is installed.

=cut

macro is_ips_installed
{var ($pkg) = @arg
 keep %cch

 if exists($cch{$pkg})
  return $cch{$pkg}
 call caller:command(concat('/usr/bin/pkg info ',$pkg,' 2>&1'))
 return $cch{$pkg} = not(status())
}

=head2 S<is_pkg_installed($pkg)>

This macro indicates whether the specified SVR4 package is installed.

=cut

macro is_pkg_installed
{var ($pkg) = @arg
 keep %cch

 if exists($cch{$pkg})
  return $cch{$pkg}
 call caller:command(concat('/usr/bin/pkginfo -q ',$pkg,' 2>&1'))
 return $cch{$pkg} = not(status())
}

=head1 LOG-RELATED MACROS

=head2 S<log_critical($msg[,$alt])>

This macro treats a critical message.

=cut

macro log_critical
{var ($msg,$alt) = @arg
 import $MOD,$PID
 keep $MOD,$PID

 if $PID
 {var $pre = concat(localtime('%b %d %H:%M:%S'),' ',${RDA.T_NODE},\
    '[',last,'] ',$MOD,':')
  echo $pre,"\001",$msg
  call $[XPL]->log($pre,' ',$msg)
 }
 else
  echo ' ',tput('bold'),nvl($alt,$msg),tput('off')
}

=head2 S<log_error($msg[,$alt])>

This macro treats an error message.

=cut

macro log_error
{var ($msg,$alt) = @arg
 import $MOD,$PID,$PRE
 keep $MOD,$PID,$PRE

 if $PID
 {var $pre = concat(localtime('%b %d %H:%M:%S'),' ',${RDA.T_NODE},\
    '[',last,'] ',$MOD,':')
  echo $pre,"\001ERROR  ",$msg
  call $[XPL]->log($pre,' ERROR  ',$msg)
 }
 else
  echo $PRE,nvl($alt,$msg)
 return true
}

=head2 S<log_exec($fil[,$alt])>

This macro generates a warning message the first time that it reports a file as
not executable.

=cut

macro log_exec
{var ($fil,$alt) = @arg
 keep %tbl

 if missing($tbl{$fil})
 {call log_warning(concat('Cannot execute ',$fil),$alt)
  var $tbl{$fil} = 1
 }
}

=head2 S<log_info($msg[,$alt])>

This macro treats an informative message.

=cut

macro log_info
{var ($msg,$alt) = @arg
 import $MOD,$PID,$PRE
 keep $MOD,$PID,$PRE

 if $PID
 {var $pre = concat(localtime('%b %d %H:%M:%S'),' ',${RDA.T_NODE},\
    '[',last,'] ',$MOD,':')
  debug $pre,"\001",$msg
  call $[XPL]->log($pre,' ',$msg)
 }
 elsif match($msg = nvl($alt,$msg),'^\s')
  debug $msg
 else
  debug $PRE,$msg
 return true
}

=head2 S<log_missing($fil[,$alt])>

This macro generates a warning message the first time that it reports a file as
missing.

=cut

macro log_missing
{var ($fil,$alt) = @arg
 keep %tbl

 if missing($tbl{$fil})
 {call log_warning(concat($fil,' not found'),$alt)
  var $tbl{$fil} = 1
 }
}

=head2 S<log_restricted($fil[,$alt])>

This macro generates a warning message the first time that it reports a file
has execution restrictions.

=cut

macro log_restricted
{var ($fil,$alt) = @arg
 keep %tbl

 if missing($tbl{$fil})
 {call log_warning(concat($fil,' has execution restrictions'),$alt)
  var $tbl{$fil} = 1
 }
}

=head2 S<log_run($msg)>

This macro treats a module execution message.

=cut

macro log_run
 return log_critical('RUNNING',@arg)

=head2 S<log_warning($msg[,$alt])>

This macro treats a warning message.

=cut

macro log_warning
{var ($msg,$alt) = @arg
 import $MOD,$PID,$PRE
 keep $MOD,$PID,$PRE

 if $PID
 {var $pre = concat(localtime('%b %d %H:%M:%S'),' ',${RDA.T_NODE},\
    '[',last,'] ',$MOD,':')
  debug $pre,"\001WARNING  ",$msg
  call $[XPL]->log($pre,' WARNING  ',$msg)
 }
 else
  debug $PRE,nvl($alt,$msg)
 return true
}

=head1 SEE ALSO

L<EXPLORER:DCxplr|collect::EXPLORER:DCxplr>

=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