
PROC qcp$install_correction (
correction_identifier, ci: name 1 .. 7 = $required
correction_file_path, cfp: file = $required
output, o: file = $output
status )

crev local_status k=status
crev ignore k=status
crev msg k=string
crev work k=string
crev count
crev check k=boolean


IF $file($value(output) open_position) = '$BOI' THEN
   ofile = $string($value(output)) //'.$ASIS'
ELSE
   ofile = $string($value(output))
IFEND

"**********************************************************************
" Establish the default values for this session
"**********************************************************************
crev qev$correction_base k=string s=xdcl
crev qev$installation_base k=string s=xdcl
crev qev$modifier_base k=string s=xdcl
crev qev$correction_identifier k=string s=xdcl



"**************************************************************************
" Setup default values
"**************************************************************************
qev$correction_base   =   ':$SYSTEM.$SYSTEM.FIELD_MAINTENANCE'
qev$target_base       =   ':$SYSTEM.$SYSTEM.QCU_MAINTENANCE'
qev$modifier_base     =   ':$SYSTEM.$SYSTEM.NOSVE_MAINTENANCE'
qev$correction        =   $string($value(correction_identifier))


crev tc_path k=string v=qev$target_base//'.LINK_INPUT_FILES'
crev cc_path k=string v=qev$correction_base//'.'//qev$correction
     cc_path = cc_path//'.LINK_INPUT_FILES'
crev er_path k=string v=qev$correction_base//'.'//qev$correction

crev mc_path k=string v=qev$modifier_base//'.LINK_INPUT_FILES'
crev id_path k=string v=qev$target_base//'.identification'
crev name_path k=string v=qev$correction_base//'.'//qev$correction//'.NAMES.$ASIS'
crev temp1 k=string v=$unique//'.$asis'
crev temp2 k=string v=$unique//'.$asis'
crev li_path k=string v=qev$correction_base//'.'//qev$correction
     li_path = li_path//'.LINK_INPUT_FILES.OS_VERSION'
crev ll_path k=string v=qev$correction_base//'.LINK_INPUT_FILES'
crev cp_path k=string v=qev$correction_base//'.PATHS'
crev psr_path k=string v=qev$correction_base//'.PSRS'


" Make sure that the field_maintenance and correction base
" catalogs exist.

detf $fname(cp_path) status=ignore

IF NOT  $file($fname(qev$modifier_base),catalog) THEN
 putl ' Unable to generate a correction system due to absence' o=$fname(ofile//)
 putl ' of the '//qev$modifier_base//' catalog' o=$fname(ofile//)
 EXIT_PROC
IFEND

crec $fname(qev$target_base) status=ignore
crec $fname(tc_path) status=ignore

putl ''   o=$fname(ofile//'.$eoi')
putl '    Begin Correction Installation' o=$fname(ofile//'.$eoi')
putl '' o=$fname(ofile//'.$eoi')
"**********************************************************************
" Fetch the repair record via the correction file path and initialize
" the correction base environment. The repair record is broken into
" three files and one catalog:
" NAMES - a file containing the names of the libraries modified by
"         this correction.
" HEADER - an image of the corrections repair record header.
"
" FIELD_MAINTENANCE.(correction id).LINK_INPUT_FILES. this is the
"         catalog that contains the modified binaries.
"
" PSRS - a file containing a list of all PSRs corrected by the contents
"        of this correction package.
"**********************************************************************
establish_qcu_environment,$value(correction_identifier), ..
 $value(correction_file_path),check
            IF NOT check THEN
              EXIT_PROC
            IFEND
include_file $fname(li_path)
" save the identifier for later use
putl $string(level_id) o=$fname(id_path)

display_catalog $fname(cc_path) o=$fname(temp2)
rewf $fname(temp2) status=ignore
crev libnew k=string d=1..20 v=''
crev libnc v=1
accl v=work i=$fname(temp2//'.$asis') lc=count
WHILE count >0 DO
 IF $substr(work,5,5) = 'FILE:' THEN
   libnew(libnc) = $substr(work,11,$strlen(work))
   libnc = libnc + 1
 IFEND
 accl v=work i=$fname(temp2//'.$asis') lc=count
WHILEND

display_catalog $fname(mc_path) o=$fname(temp1)
rewf $fname(temp1) status=ignore
crev libold k=string d=1..20 v=''
crev liboc v=1
accl v=work i=$fname(temp1//'.$asis') lc=count
WHILE count >0 DO
 IF $substr(work,5,5) = 'FILE:' THEN
   libold(liboc) = $substr(work,11,$strlen(work))
   liboc = liboc + 1
 IFEND
 accl v=work i=$fname(temp1//'.$asis') lc=count
WHILEND

 crev bf_path k=string
 crev cf_path k=string
 crev tf_path k=string
 crev lf_path k=string
 crev repair  k=boolean


       FOR i = 1 TO liboc-1 DO
         IF libold(i) <> 'OS_VERSION' THEN
            lib = libold(i)
                repair = FALSE
              FOR j = 1 TO libnc DO
                IF libnew(j) = lib THEN
                   repair = TRUE
                   EXIT
                IFEND
              FOREND
          IFEND
            cf_path = cc_path//'.'//lib
            bf_path = mc_path//'.'//lib
            tf_path = tc_path//'.'//lib
            lf_path = ll_path//'.'//lib
          IF repair THEN
               putl '       Repairing Library '//lib   o=$fname(ofile//'.$eoi')
               apply_correction,$fname(bf_path),$fname(cf_path),$fname(tf_path),status=local_status
                IF NOT local_status.normal THEN
                 EXIT_PROC WITH local_status
                IFEND
                  " Save the paths and modified libraries
                 rewf $fname(tf_path) status=ignore
                 copf $fname(tf_path) $fname(lf_path)
                  msg = $trim(lib)
                  msg = msg//$substr('',1,30-$strlen(msg))//ci
                  putl msg  o=$fname(cp_path//'.$eoi')

           ELSE
             IF $file($fname(lf_path),permanent) THEN
                copy_file $fname(lf_path) $fname(tf_path) status=local_status
             ELSE
                copy_file $fname(bf_path) $fname(tf_path) status=local_status
             IFEND
               IF NOT local_status.normal THEN
                  EXIT_PROC WITH local_status
               IFEND
           IFEND
           FOREND

           copy_file $fname(cc_path//'.OS_VERSION') $fname(tc_path//'.OS_VERSION') status=local_status
               IF NOT local_status.normal THEN
                  EXIT_PROC WITH local_status
               IFEND

crev hi_path k=string v=qev$correction_base//'.HISTORY'
crev ho_path k=string v=qev$correction_base//'.HISTORY_LINE'
copf $fname(ho_path) $fname(hi_path//'.$eoi')
delf $fname(ho_path) status=ignore
detf $fname(hi_path) status=ignore
detf $fname(cp_path) status=ignore

        putl '' o=$fname(ofile//'.$eoi')
        putl '     End Installation of '//qev$correction//' Correction Level' o=$fname(ofile//'.$eoi')
        putl '' o=$fname(ofile//'.$eoi')

PROCEND qcp$Install_correction
