# PRSFr73.def: Collects Portal Software 7.0, 7.2 or 7.3 Information
# $Id: PRSFr73.def,v 1.15 2008/02/25 17:32:55 mschenke Exp $
# ARCS: $Header: /home/cvs/repository/RDA_4/src/scripting/lib/modules/PRSFr73.def,v 1.15 2008/02/25 17:32:55 mschenke Exp $
#
# Change History
# 20080225  MSC  Change the copyright notice.

=head1 NAME

PRSFr73 - Collect Information on Portal Software 7.0, 7.2 or 7.3

=head1 DESCRIPTION

This module collects information on Portal or integRate pipeline-based systems.

=cut

# Initialisation
var $PRSF_VERSION = $arg[0]
var $PRSF_TAIL    = getSetting('PRSF_TAIL',5000)

var $TOC = '%TOC%'
var $TOP = '[[#Top][Back to top]]'

echo tput('bold'),'Processing Portal Software ',$PRSF_VERSION,' module ...',\
     tput('off')

# --- Data collection macros --------------------------------------------------

# Collect information for Portal based systems
macro run_portal
{var () = @arg
 import $TOP

 # Check the presence of required environment variables
 var $hom = getEnv('PIN_HOME')
 var $log = getEnv('PIN_LOG',getEnv('PIN_LOG_DIR'))
 if !and($hom,$log)
  return 'PIN_HOME and PIN_LOG/PIN_LOG_DIR must be set'

 # Process all components
 debug ' Inside PRSFr73 module, processing all components (can take time)'
 pretoc '2:Components'
 prefix
 {write '---++ Components'
  write '<verbatim>'
 }
 var %inv = ('dd',1,'config',1,'data',1,'msgs',1)
 loop $nam (find_elements($hom,'sys',\%inv))
 {debug '    ',$nam,' ...'
  pretoc "3:Component '",$nam,"'"
  write "Component '",$nam,"'"
  if match($nam,'^(cm$|dm_oracle)')
   call send_sigusr1($log,$nam)
  call process_element($hom,$log,'sys',$nam)
  if compare('eq',$nam,'dm_ifw_sync')
   call copy_file('f',catDir($hom,'sys','dm_ifw_sync'),'ifw_sync_queuenames')
  unpretoc
 }
 if hasOutput(true)
 {write '</verbatim>'
  write $TOP
 }
 unpretoc

 # Process all applications
 debug ' Inside PRSFr73 module, processing all applications (can take time)'
 pretoc '2:Applications'
 prefix
 {write '---++ Applications'
  write '<verbatim>'
 }
 var %inv = ()
 loop $nam (find_elements($hom,'apps',\%inv))
 {debug '    ',$nam,' ...'
  pretoc "3:Application '",$nam,"'"
  write "Application '",$nam,"'"
  call process_element($hom,$log,'apps',$nam)
  unpretoc
 }
 if hasOutput(true)
 {write '</verbatim>'
  write $TOP
 }
 unpretoc

 # Indicate a successful completion
 return ''
}

# Collect the pipeline information
macro run_program
{var ($reg,$int) = @arg
 var $nam = basename($reg,'.reg')
 var $pgm = "ifw"

 debug ' Inside PRSFr73 module, gathering pipeline information for ',$nam
 write '---+ Registry ',$nam,' from ',$int

 # Check the presence of required environment variables
 var $hom = $int
 if !$hom
  return 'INT_HOME is not set'

 # Check if the package can be initialized
 pretoc "2:Registry '",$nam,"'"," from '",$int,"'"
 var $alt = getEnv('PIN_HOME')
 var @dir = (getEnv('INT_PERL_LIB'),\
             catDir($hom,'tools','PerlLib'),\
             catDir($hom,'ThirdPartyApps','tools','PerlLib'),\
             cond($alt,list(catDir($alt,'tools','PerlLib'),\
                            catDir($alt,'ThirdPartyApps','tools','PerlLib')),\
                       list()))
 if extern('PrRegRd','check_package',@dir)
 {var $msg = last
  write 'Cannot access registry:%BR%'
  return $msg
 }

 # Read the registry
 write '<verbatim>'
 debug " Inside PRSFr73 module, reading registry '",$reg,"'"
 write "Reading registry '",$reg,"'"
 var $inf = extern('PrRegRd','read_registry',$reg)
 if !ref($inf)
 {write 'Cannot read registry:%BR%'
  return getDataError()
 }
 write 'Registry read done'

 # Copy registries
 pretoc '3:Registry'
 debug ' Inside PRSFr73 module, copying registries'
 write
 write 'Copying registries ...'
 var $pre = concat('reg_',$nam)
 call copy_file($pre,$hom,$reg)
 call copy_file($pre,$hom,info2file($hom,getDataValue($inf,'Info')))
 write 'Registry copy done'
 unpretoc

 # Copy descriptions
 pretoc '3:Descriptions'
 debug ' Inside PRSFr73 module, copying descriptions'
 write
 write 'Copying descriptions ...'
 var $pre = concat('dsc_',$nam)
 call copy_file($pre,$hom,getDataValue($inf,'Alias'))
 loop $pth (getDataKeys($inf,'FormatDescs'))
  call copy_file($pre,$hom,$pth)
 write 'Description files copy done'
 unpretoc

 # Collect log files
 pretoc '3:Log Files'
 debug ' Inside PRSFr73 module, collecting log files'
 write
 write 'Collecting log file newest entries ...'
 write '(only 10 newest Stream-Logs/Format)'
 var $pre = concat('log_',$nam)
 loop $pth (find_logs($hom,$inf))
  call tail_file($pre,$hom,$pth)
 write 'Log File copy done ...'
 unpretoc

 # Copy trace files
 pretoc '3:Trace Files'
 debug ' Inside PRSFr73 module, collecting trace files'
 write
 write 'Copying trace files ...'
 var $pre = concat('trc_',$nam)
 loop $pth (grepDir($hom,'trace','np'))
  call copy_file($pre,$hom,$pth)
 write 'Trace file copy done'
 unpretoc

 # Get Integrate information
 if testFile('x',catFile($hom,'bin',$pgm))
 {debug ' Inside PRSFr73 module, collecting pipeline information'
  write
  write 'Collecting pipeline information ...'

  var $cmd = concat(lastCommand(),' -v')
  suspend log
  report concat('ifw_',$nam,'_',$int)
  write '---+ Pipeline Information'
  write '---++ Using: ',$cmd
  var $rpt = getFile()
  var $tmp = getTemp('ifw')
  call command(concat($cmd,' 2>',quote($tmp,'x')))
  call writeFile($tmp)
  call unlinkTemp('ifw')
  suspend rpt
  resume log
  write "  '",$cmd,"' -> ",cond(expr('>>',status(),8),'failed',$rpt)

  var $cmd = concat($cmd,' -r ',quote($reg,'x'))
  suspend log
  resume rpt
  write '---++ Using: ',$cmd
  var $tmp = getTemp('ifw')
  call command(concat($cmd,' 2>',quote($tmp,'x')))
  call writeFile($tmp)
  call unlinkTemp('ifw')
  toc '3:[[',$rpt,'][rda_report][Pipeline Information]]'
  resume log
  write "  '",$cmd,"' -> ",cond(expr('>>',status(),8),'failed',$rpt)
 }

 write 'Collect done'
 write '</verbatim>'
 unpretoc
 return ''
}

# --- Internal collection macros ----------------------------------------------

# Collect log and pinlog files
macro collect_logs
{var ($log,$sub,$nam,$dir,$fil,$pat) = @arg

 # Initialisation
 var $cnt = 0
 var $pat = concat($pat,'(.*)$')

 # Read start script
 if createBuffer('PIN','R',catFile($dir,$fil))
 {while getLine('PIN')
  {var $lin = chomp(last)
   next match($lin,'^#') 
   if match($lin,$pat)
    incr $cnt,tail_file('t',$dir,replaceEnv(trim(substr(last,1))))
  }
  call deleteBuffer('PIN')
 }
 else
  write 'Cannot open ',$fil

 # Copy log file if exists
 if compare('eq',$nam,'batch_controller')
  var $log_file = 'BatchController.log'
 else
  var $log_file = concat($nam,'.log')
 if or(testFile('e',catFile($log,$nam,$log_file)),\
       testFile('e',catFile($dir,$log_file)))
  incr $cnt,tail_file('t',$dir,lastFile())

 # Return the number of files found
 return $cnt
}

# Find all the components for collecting logs
macro find_elements
{var ($hom,$sub,\%inv) = @arg

 var ($cnt,@tbl) = (0)
 var $dir = catDir($hom,$sub)
 loop $nam (grepDir($dir,'^\.\.?$','nv'))
 {next !testDir('d',catDir($dir,$nam))
  next exists($inv{$nam})
  var @tbl = (@tbl,$nam)
  incr $cnt
 }
 if !$cnt
  debug 'There are no elements available in ',$dir
 return @tbl
}

# Find all log file names and verify their existence
macro find_logs
{var ($dir,$inf) = @arg
 var %tbl = ()

 # Search for logs
 if $inf
 {# Examine process log
  var $pth = info2file($dir,getDataValue($inf,'Process'))
  if testFile('fr',$pth)
   var $tbl{$pth} = 1

  # Examine format logs
  loop $itm (getDataValue($inf,'FormatLogs'))
  {var $pth = info2file($dir,$itm)
   if testFile('fr',$pth)
    var $tbl{$pth} = 1
  }

  # Examine stream logs
  loop $itm (getDataValue($inf,'StreamLogs'))
  {var $cnt = 10
   var $pth = getDataValue($itm,'Path')
   if !isAbsolute($pth)
    var $pth = catFile($dir,$pth)
   loop $pth (grepDir($pth,\
                      concat(getDataValue($itm,'Prefix'),'.*',\
                             getDataValue($itm,'Suffix')),\
                      'pt'))
   {var $tbl{$pth} = 1
    decr $cnt
    break !$cnt
   }
  }
 }

 # Report all logs found
 loop $nam (keys(%tbl))
  write '  ',$nam

 return keys(%tbl)
}

# Derive the file path from the data structure
macro info2file
{var ($dir,$inf) = @arg
 if defined($inf)
 {var $pth = catFile(getDataValue($inf,'Path'),\
                     concat(getDataValue($inf,'Prefix'),\
                            getDataValue($inf,'Name'),\
                            getDataValue($inf,'Suffix')))
  return cond(isAbsolute($pth),$pth,catFile($dir,$pth))
 }
 return undef
}

# Collect logs for each component
macro process_element
{var ($hom,$log,$sub,$nam) = @arg

 # Initialisation
 var $dir = catDir($hom,$sub,$nam)

 # Copy pinlog and log files when pin.conf exists
 var $fil = 'pin.conf'
 if and(testFile('e',catFile($dir,$fil)),\
        collect_logs($log,$sub,$nam,$dir,$fil,'logfile'))
  call copy_file('f',$dir,$fil)

 # Check for Infranet.properties only for applications
 var $fil = 'Infranet.properties'
 if and(testFile('e',catFile($dir,$fil)),\
        collect_logs($log,$sub,$nam,$dir,$fil,'infranet.log.file'))
  call copy_file('f',$dir,$fil)

 # Copy default.pinlog when exists
 var $fil = 'default.pinlog'
 if testFile('e',catFile($dir,$fil))
 {call tail_file('t',$dir,$fil)
  if compare('eq',$nam,'test')
   call copy_file('f',$dir,'pin.conf')
 }

 # Copy core when exists
 call copy_data('f',$dir,'core')
}

# Send SIGUSR1 signal to dm_oracle and cm processes
macro send_sigusr1
{var ($log,$nam) = @arg

 # Get process id from PID_FILE
 var $fil = catFile($log,$nam,concat($nam,'.pid'))
 var ($pid) = grepFile($fil,'\d+','f')
 if !$pid
 {write "Cannot open ",$fil
  return 1
 }

 # Check the process existence before sending SIGUSR1
 if !kill(0,$pid)
 {write '  ',$nam,' process (',$pid,') is not in running state'
  return 1
 }
 if !kill('USR1',$pid)
 {write '  Successfully sent the signal SIGUSR1 to ',$pid
  return 1
 }
 write '  Failed to send signal SIGUSR1 to ',$pid
 return 0
}

# --- File copy macros --------------------------------------------------------

# Copy a data file
macro copy_data
{var ($pre,$dir,$fil) = @arg

 if length($fil)
 {if !isAbsolute($fil)
   var $fil = catFile($dir,$fil)
  if testFile('e',$fil)
  {suspend log
   data concat($pre,$fil)
   var $nam = basename($fil)
   var $ret = writeData($fil)
   var $rpt = getFile()
   if isCreated(true)
    toc '4:[[',$rpt,'][rda_report][',$nam,']]'
   resume log
   write '  ',$fil,' -> ',cond($ret,$rpt,'failed')
  }
 }
}

# Copy a file
macro copy_file
{var ($pre,$dir,$fil) = @arg

 if length($fil)
 {if !isAbsolute($fil)
   var $fil = catFile($dir,$fil)
  if testFile('e',$fil)
  {suspend log
   report concat($pre,$fil)
   prefix
   {write '---+ Display of ',$nam,' File'
    write '---## Information Taken from ',$fil
   }
   var $nam = basename($fil)
   var $ret = writeFile($fil)
   var $rpt = getFile()
   if isCreated(true)
    toc '4:[[',$rpt,'][rda_report][',$nam,']]'
   resume log
   write '  ',$fil,' -> ',cond($ret,$rpt,'failed')
  }
 }
}

# Tail a file
macro tail_file
{var ($pre,$dir,$fil) = @arg
 import $PRSF_TAIL
 keep $PRSF_TAIL

 var $ret = 0
 if length($fil)
 {if !isAbsolute($fil)
   var $fil = catFile($dir,$fil)
  if testFile('e',$fil)
  {suspend log
   report concat($pre,$fil)
   prefix
   {write '---+ Last ',$PRSF_TAIL,' Lines of ',$nam,' File'
    write '---## Information Taken from ',$fil
   }
   var $nam = basename($fil)
   var $ret = writeTail($fil,$PRSF_TAIL)
   var $rpt = getFile()
   if isCreated(true)
   {var $ret = 1
    toc '4:[[',$rpt,'][rda_report][',$nam,']]'
   }
   resume log
   write '  ',$fil,' -> ',cond($ret,$rpt,'failed')
  }
 }
 return $ret
}

=head1 PORTAL BASED SYSTEM

The following reports can be generated and are regrouped under C<Portal System>:

=head2 pin_log - Collection Log

Provides the collection details.

=head2 Pin and log files

Collects all log and pinlog files of all components and all applications.

=cut

if getSetting('PRSF_PORTAL')
{debug ' Inside PRSFr73 module, gathering Portal system information'
 toc '1:Portal System (',$PRSF_VERSION,')'
 report pin_log
 write '---+!! Portal System Information'
 write $TOC
 toc '2:[[',getFile(),'][rda_report][Collection Log]]'
 if run_portal()
 {write last
  echo last
 }
 pretoc '2:Extra Files'
 prefix
 {write '---++ Extra Files'
  write '<verbatim>'
 }
 call copy_file('x',getEnv('HOME'),'vpd.properties')
 if getEnv('PIN_HOME')
  call copy_file('x',catDir(last,'bin'),'pinrev.dat')
 if getEnv('PIN_LOG',getEnv('PIN_LOG_DIR'))
  call copy_file('x',last,'portal_patchlog')
 if hasOutput(true)
 {write '</verbatim>'
  write $TOP
 }
 unpretoc
}

=head1 PIPELINE BASED SYSTEM

The following reports can be generated and are regrouped under C<Pipeline
Manager>:

=head2 ifw_log - Collection Log

Provides the collection details.

=head2 Registry, description, log and trace files.

Reads the specified registry files and collects information such as
description, log, and trace files for each of the registry files. It captures
the pipeline information also.

=cut

if getSetting('PRSF_REGISTRY')
{var ($all,%dir) = (last)
 debug ' Inside PRSFr73 module, gathering Pipeline Manager information'
 if isTocCreated(true)
  toc '%SPLIT%'
 toc '1:Pipeline Manager(',$PRSF_VERSION,')'
 report ifw_log
 write '---+!! Pipeline Manager Information'
 write $TOC
 toc '2:[[',getFile(),'][rda_report][Collection Log]]'
 if getSetting('PRSF_ONE_HOME')
 {var $dir = getSetting('PRSF_INT_HOME',getEnv('INT_HOME'))
  var $dir{$dir} = 1
  loop $reg (split('\|',$all))
  {if run_program($reg,$dir)
   {write last
    echo last
   }
  }
 }
 elsif getSetting('PRSF_REG_SETS')
 {loop $set (split('\|',last))
  {var $dir = getSetting(concat('PRSF_INT_',$set))
   var $dir{$dir} = 1
   if run_program(getSetting(concat('PRSF_REG_',$set)),$dir)
   {write last
    echo last
   }
  }
 }
 pretoc '2:Extra Files'
 prefix
 {write '---++ Extra Files'
  write '<verbatim>'
 }
 call copy_file('x',getEnv('HOME'),'vpd.properties')
 loop $dir (keys(%dir))
  call copy_file('x',catDir($dir,'bin'),'piperev.dat')
 if hasOutput(true)
 {write '</verbatim>'
  write $TOP
 }
 unpretoc
}

=head1 SEE ALSO

See also L<S380PRSF.def|modules::S380PRSF>.

=begin credits

=over 10

=item RDA 4.7:  Nameer Jalel, Steve Schow.

=item RDA 4.8:  Nameer Jalel.

=item RDA 4.9:  Nameer Jalel.

=back

=end credits

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2008, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut