ZIBRPI ; IHS/ADC/GTH - REMOTE PATCH INSTALLATION ; [ 11/04/97 10:26 AM ]
;;3.0;IHS/VA UTILITIES;**1,2,3**;FEB 07, 1997
; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
;
; For a description of this utility, see the text in routine
; ZIBRPI2.
;
; D = Directory containing patch files
; D("OUT") = Directory with results files
; E = "Action" routine, named (A/B)9<namespace><patch_number>
; F = Name of a file containing a patch
; J = Today's Julian date
; L = Facility's Pseudo Prefix
; N = Namespace derived from the name of the file
; O = Operating System, and OS-specific commands
; P = PACKAGE file IEN
; V = Version derived from the name of the file
; W = Work file
;
W !!,"EXECUTION UNAUTHORIZED.",!
Q
;
OPT ;EP - Set option in OPTION file. Called by a programmer.
D OPT^ZIBRPI1
Q
;
START ;EP - From TaskMan.
NEW %ZIS,D,DA,DIC,E,F,I,J,L,N,O,P,POP,V,W,XMSUB,XMTEXT,XMY
D HFS
Q:POP
D OS
KILL ^TMP($J)
; rm xmit files over 2 weeks old.
S L=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),1),U,2) I '($L(L)=3) S L="RPI"
D HC(O("LS")_D("OUT")_O("NS")_L_".* > "_W)
S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
D ZIS,JDT
U IO
; Comment next line to keep xmit ("rpi") files over 2 wks old.
F R %:300 Q:%="" S %=$P(%,"/",$L(%,"/")),X=+$P(%,".",2) I $P(%,".")=O("NS")_L,((+X>+J)!(+X<(+J-14))) D HC(O("RM")_D("OUT")_%)
D HC(O("RM")_W)
; Initialize namespace, systems, and frequency.
S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),D=$P($P(^(20),"""",2),U)
S:'("/\"[$E(D,$L(D))) D=D_$S(O["UNIX":"/",1:"\")
D HC(O("LS")_D_"*.*"_" > "_W)
S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
D ZIS
U IO
; The Q:%="" in the following line is non-standard MUMPS.
F R %:300 Q:%="" S %=$P(%,"/",$L(%,"/")) I %?@O("PF") S ^TMP($J,"ZIBRPI",%)=""
S F=""
I '$L($O(^TMP($J,"ZIBRPI",""))) D ZISC D HC(O("RM")_W) KILL ^TMP($J) S:$D(ZTQUEUED) ZTREQ="@" Q
MAIN ;
F S F=$O(^TMP($J,"ZIBRPI",F)) Q:F="" D S ^TMP($J,"ZIBRPI",F)=% D:%="INSTALLED" HC(O("RM")_D_F)
. S X=$E(F,1,4),X=$P(X,"_"),N=$$UP^XLFSTR(X)
. I '$D(^DIC(9.4,"C",N)) S %="FAILED - Not an Installed Package" Q
. S P=$O(^DIC(9.4,"C",N,0))
. I 'P S %="FAILED - Bad ""C"" x-ref for "_N Q
. I '$D(^DIC(9.4,P,"VERSION")) S %="FAILED - 'VERSION' Node Missing" Q
. S V=+($E(F,5,6)_"."_$E(F,7,8))
. I (+V)'=(+^DIC(9.4,P,"VERSION")) S %="FAILED - V "_^("VERSION")_" of "_N_" is Installed" Q
. ; S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_$P($P(F,".",2),"p",2) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
. S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_(+$P($P(F,".",2),"p",1)) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
. U IO:(D_F)
. R %:300
. R %:300
. ; The ZL and ZS in the following line are non-standard M commands.
. F R %:300 Q:%="" S:%=E ^TMP($J,"B9",%)="" X "ZL ZS @%"
. S DA(1)=^DIC(9.4,P,"VERSION"),DA(1)=$O(^DIC(9.4,P,22,"B",DA(1)_$S(DA(1)[".":"",1:".0"),0))
. I 'DA(1) S DA(1)=$P(^DIC(9.4,P,22,0),U,3)
. S:'$D(^DIC(9.4,P,22,DA(1),"PAH",0)) ^(0)="^9.4901^^"
. ; S X=N_"*"_V_"*"_$P($P(F,".",2),"p",2),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
. S X=N_"*"_V_"*"_(+$P($P(F,".",2),"p",1)),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
. D FILE
. S %="INSTALLED"
. Q
ENDMAIN ;
D OS
S %=0,F="",D=D("OUT")_O("NS")_L_"."_J
U IO:(D:"W")
F S F=$O(^TMP($J,"ZIBRPI",F)) Q:F="" W L,U,F,U,^(F),U,DT,! S %=%+1,XMTEXT(%)="Restore from file "_$E(F_$J("",14),1,14)_": "_^(F)
U IO:(W)
D ZISC,HC(O("RM")_W)
; uucp according to parameter: ENTRY ACTION of option.
S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),E=$P($P(^(20),"""",2),U,2)
I O["UNIX" D
. I '(%=2) D HC("uucp -r "_D_" "_$P($T(SYTM),";",3)_"!~")
. I %>1 D HC("uucp -r -nroot "_D_" "_$P(^AUTTSITE(1,0),U,14)_"!~")
. Q
S XMTEXT="XMTEXT(",XMSUB=$P($P($T(ZIBRPI),";",2),"-",2),XMY(1)=""
D XMD
I E S %="" F S %=$O(^TMP($J,"B9",%)) Q:%="" D RTN(U_%)
KILL ^TMP($J)
S ZTREQ="@"
Q ;
Q
;
DIE NEW D,E,F,I,J,L,N,O,P,V,W D ^DIE Q
DIR NEW D,E,F,I,J,L,N,O,P,V,W D ^DIR Q
DTC NEW D,E,F,I,J,L,N,O,P,V,W D ^%DTC Q
FILE NEW D,E,F,I,J,L,N,O,P,V,W KILL DD,DO D FILE^DICN Q
HC(%) NEW D,E,F,I,J,L,N,O,P,V,W S %=$$JOBWAIT^%HOSTCMD(%) Q
RTN(%) NEW D,E,F,I,J,L,N,O,P,V,W D @(%) Q
XMD NEW D,E,F,I,J,L,N,O,P,V,W D ^XMD Q
ZIS NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZIS Q
ZISC NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZISC Q
;
HFS ;
; F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucpublic/work.zib"":""W"")" D ZIS Q:'POP ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucppublic/work.zib"":""W"")" D ZIS Q:'POP ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
I 'I,'$D(POP) S POP=1
Q:POP
S I=$P(^%ZIS(1,I,0),U)
Q
;
JDT ;
NEW X1,X2
S X2=$E(DT,1,3)_"0101",X1=DT
D DTC
S X=X+1,X="00"_X,J=$E(X,$L(X)-2,$L(X))
Q
;
OS ; The "IN" directory is retrieved from the OPTION entry.
S O=$P($P(^%ZOSF("OS"),","),"-",2),O("PF")=$P($T(PATTERN),";",3)
S W=$P($T(WORK),";",3),O("NS")=$P($T(NS),";",3)
I O["UNIX" S (D("IN"),D("OUT"))=$P($T(PUB),";",3),O("RM")="rm ",O("LS")="ls -l ",W=D("OUT")_W Q
S %=$G(^AUTTSITE(1,1)),D("IN")=$P(%,U),D("OUT")=$P(%,U,2),O("RM")="DEL ",O("LS")="DIR /B "
Q
;
; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
; Old PATTERN:
;;2.4L.2"_"4N1"."1"p"1.2N
SYTM ;;dpssyg
PATTERN ;;2.4L.2"_"4N1"."1.2N1"p"; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
WORK ;;ZIBRPI.WRK
PUB ;;/usr/spool/uucppublic/
NS ;;ZIB_P
ZIBRPI ; IHS/ADC/GTH - REMOTE PATCH INSTALLATION ; [ 11/04/97 10:26 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**1,2,3**;FEB 07, 1997
+2 ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
+3 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
+4 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
+5 ;
+6 ; For a description of this utility, see the text in routine
+7 ; ZIBRPI2.
+8 ;
+9 ; D = Directory containing patch files
+10 ; D("OUT") = Directory with results files
+11 ; E = "Action" routine, named (A/B)9<namespace><patch_number>
+12 ; F = Name of a file containing a patch
+13 ; J = Today's Julian date
+14 ; L = Facility's Pseudo Prefix
+15 ; N = Namespace derived from the name of the file
+16 ; O = Operating System, and OS-specific commands
+17 ; P = PACKAGE file IEN
+18 ; V = Version derived from the name of the file
+19 ; W = Work file
+20 ;
+21 WRITE !!,"EXECUTION UNAUTHORIZED.",!
+22 QUIT
+23 ;
OPT ;EP - Set option in OPTION file. Called by a programmer.
+1 DO OPT^ZIBRPI1
+2 QUIT
+3 ;
START ;EP - From TaskMan.
+1 NEW %ZIS,D,DA,DIC,E,F,I,J,L,N,O,P,POP,V,W,XMSUB,XMTEXT,XMY
+2 DO HFS
+3 IF POP
QUIT
+4 DO OS
+5 KILL ^TMP($JOB)
+6 ; rm xmit files over 2 weeks old.
+7 SET L=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),1),U,2)
IF '($LENGTH(L)=3)
SET L="RPI"
+8 DO HC(O("LS")_D("OUT")_O("NS")_L_".* > "_W)
+9 SET IOP=I
SET %ZIS("IOPAR")="("""_W_""":""R"")"
+10 DO ZIS
DO JDT
+11 USE IO
+12 ; Comment next line to keep xmit ("rpi") files over 2 wks old.
+13 FOR
READ %:300
IF %=""
QUIT
SET %=$PIECE(%,"/",$LENGTH(%,"/"))
SET X=+$PIECE(%,".",2)
IF $PIECE(%,".")=O("NS")_L
IF ((+X>+J)!(+X<(+J-14)))
DO HC(O("RM")_D("OUT")_%)
+14 DO HC(O("RM")_W)
+15 ; Initialize namespace, systems, and frequency.
+16 SET %=+$PIECE(^DIC(19,$ORDER(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2)
SET D=$PIECE($PIECE(^(20),"""",2),U)
+17 IF '("/\"[$EXTRACT(D,$LENGTH(D)))
SET D=D_$SELECT(O["UNIX":"/",1:"\")
+18 DO HC(O("LS")_D_"*.*"_" > "_W)
+19 SET IOP=I
SET %ZIS("IOPAR")="("""_W_""":""R"")"
+20 DO ZIS
+21 USE IO
+22 ; The Q:%="" in the following line is non-standard MUMPS.
+23 FOR
READ %:300
IF %=""
QUIT
SET %=$PIECE(%,"/",$LENGTH(%,"/"))
IF %?@O("PF")
SET ^TMP($JOB,"ZIBRPI",%)=""
+24 SET F=""
+25 IF '$LENGTH($ORDER(^TMP($JOB,"ZIBRPI","")))
DO ZISC
DO HC(O("RM")_W)
KILL ^TMP($JOB)
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
MAIN ;
+1 FOR
SET F=$ORDER(^TMP($JOB,"ZIBRPI",F))
IF F=""
QUIT
Begin DoDot:1
+2 SET X=$EXTRACT(F,1,4)
SET X=$PIECE(X,"_")
SET N=$$UP^XLFSTR(X)
+3 IF '$DATA(^DIC(9.4,"C",N))
SET %="FAILED - Not an Installed Package"
QUIT
+4 SET P=$ORDER(^DIC(9.4,"C",N,0))
+5 IF 'P
SET %="FAILED - Bad ""C"" x-ref for "_N
QUIT
+6 IF '$DATA(^DIC(9.4,P,"VERSION"))
SET %="FAILED - 'VERSION' Node Missing"
QUIT
+7 SET V=+($EXTRACT(F,5,6)_"."_$EXTRACT(F,7,8))
+8 IF (+V)'=(+^DIC(9.4,P,"VERSION"))
SET %="FAILED - V "_^("VERSION")_" of "_N_" is Installed"
QUIT
+9 ; S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_$P($P(F,".",2),"p",2) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
+10 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
SET E=$SELECT("AB"[$EXTRACT(N):$EXTRACT(N),1:"B")_"9"_N_(+$PIECE($PIECE(F,".",2),"p",1))
+11 USE IO:(D_F)
+12 READ %:300
+13 READ %:300
+14 ; The ZL and ZS in the following line are non-standard M commands.
+15 FOR
READ %:300
IF %=""
QUIT
IF %=E
SET ^TMP($JOB,"B9",%)=""
XECUTE "ZL ZS @%"
+16 SET DA(1)=^DIC(9.4,P,"VERSION")
SET DA(1)=$ORDER(^DIC(9.4,P,22,"B",DA(1)_$SELECT(DA(1)[".":"",1:".0"),0))
+17 IF 'DA(1)
SET DA(1)=$PIECE(^DIC(9.4,P,22,0),U,3)
+18 IF '$DATA(^DIC(9.4,P,22,DA(1),"PAH",0))
SET ^(0)="^9.4901^^"
+19 ; S X=N_"*"_V_"*"_$P($P(F,".",2),"p",2),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
+20 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
SET X=N_"*"_V_"*"_(+$PIECE($PIECE(F,".",2),"p",1))
SET DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"","
SET DIC(0)=""
SET DIC("DR")=".02///"_DT_";.03///.5"
SET DA(2)=P
+21 DO FILE
+22 SET %="INSTALLED"
+23 QUIT
End DoDot:1
SET ^TMP($JOB,"ZIBRPI",F)=%
IF %="INSTALLED"
DO HC(O("RM")_D_F)
ENDMAIN ;
+1 DO OS
+2 SET %=0
SET F=""
SET D=D("OUT")_O("NS")_L_"."_J
+3 USE IO:(D:"W")
+4 FOR
SET F=$ORDER(^TMP($JOB,"ZIBRPI",F))
IF F=""
QUIT
WRITE L,U,F,U,^(F),U,DT,!
SET %=%+1
SET XMTEXT(%)="Restore from file "_$EXTRACT(F_$JUSTIFY("",14),1,14)_": "_^(F)
+5 USE IO:(W)
+6 DO ZISC
DO HC(O("RM")_W)
+7 ; uucp according to parameter: ENTRY ACTION of option.
+8 SET %=+$PIECE(^DIC(19,$ORDER(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2)
SET E=$PIECE($PIECE(^(20),"""",2),U,2)
+9 IF O["UNIX"
Begin DoDot:1
+10 IF '(%=2)
DO HC("uucp -r "_D_" "_$PIECE($TEXT(SYTM),";",3)_"!~")
+11 IF %>1
DO HC("uucp -r -nroot "_D_" "_$PIECE(^AUTTSITE(1,0),U,14)_"!~")
+12 QUIT
End DoDot:1
+13 SET XMTEXT="XMTEXT("
SET XMSUB=$PIECE($PIECE($TEXT(ZIBRPI),";",2),"-",2)
SET XMY(1)=""
+14 DO XMD
+15 IF E
SET %=""
FOR
SET %=$ORDER(^TMP($JOB,"B9",%))
IF %=""
QUIT
DO RTN(U_%)
+16 KILL ^TMP($JOB)
+17 SET ZTREQ="@"
Q ;
+1 QUIT
+2 ;
DIE NEW D,E,F,I,J,L,N,O,P,V,W
DO ^DIE
QUIT
DIR NEW D,E,F,I,J,L,N,O,P,V,W
DO ^DIR
QUIT
DTC NEW D,E,F,I,J,L,N,O,P,V,W
DO ^%DTC
QUIT
FILE NEW D,E,F,I,J,L,N,O,P,V,W
KILL DD,DO
DO FILE^DICN
QUIT
HC(%) NEW D,E,F,I,J,L,N,O,P,V,W
SET %=$$JOBWAIT^%HOSTCMD(%)
QUIT
RTN(%) NEW D,E,F,I,J,L,N,O,P,V,W
DO @(%)
QUIT
XMD NEW D,E,F,I,J,L,N,O,P,V,W
DO ^XMD
QUIT
ZIS NEW D,E,F,I,J,L,N,O,P,V,W
DO ^%ZIS
QUIT
ZISC NEW D,E,F,I,J,L,N,O,P,V,W
DO ^%ZISC
QUIT
+1 ;
HFS ;
+1 ; F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucpublic/work.zib"":""W"")" D ZIS Q:'POP ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
+2 ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
FOR I=0:0
SET I=$ORDER(^%ZIS(1,I))
IF 'I
QUIT
IF ^(I,"TYPE")="HFS"
SET IOP=$PIECE(^%ZIS(1,I,0),U)
SET %ZIS("IOPAR")="(""/usr/spool/uucppublic/work.zib"":""W"")"
DO ZIS
IF 'POP
QUIT
+3 IF 'I
IF '$DATA(POP)
SET POP=1
+4 IF POP
QUIT
+5 SET I=$PIECE(^%ZIS(1,I,0),U)
+6 QUIT
+7 ;
JDT ;
+1 NEW X1,X2
+2 SET X2=$EXTRACT(DT,1,3)_"0101"
SET X1=DT
+3 DO DTC
+4 SET X=X+1
SET X="00"_X
SET J=$EXTRACT(X,$LENGTH(X)-2,$LENGTH(X))
+5 QUIT
+6 ;
OS ; The "IN" directory is retrieved from the OPTION entry.
+1 SET O=$PIECE($PIECE(^%ZOSF("OS"),","),"-",2)
SET O("PF")=$PIECE($TEXT(PATTERN),";",3)
+2 SET W=$PIECE($TEXT(WORK),";",3)
SET O("NS")=$PIECE($TEXT(NS),";",3)
+3 IF O["UNIX"
SET (D("IN"),D("OUT"))=$PIECE($TEXT(PUB),";",3)
SET O("RM")="rm "
SET O("LS")="ls -l "
SET W=D("OUT")_W
QUIT
+4 SET %=$GET(^AUTTSITE(1,1))
SET D("IN")=$PIECE(%,U)
SET D("OUT")=$PIECE(%,U,2)
SET O("RM")="DEL "
SET O("LS")="DIR /B "
+5 QUIT
+6 ;
+7 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
+8 ; Old PATTERN:
+9 ;;2.4L.2"_"4N1"."1"p"1.2N
SYTM ;;dpssyg
PATTERN ;;2.4L.2"_"4N1"."1.2N1"p"; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
WORK ;;ZIBRPI.WRK
PUB ;;/usr/spool/uucppublic/
NS ;;ZIB_P
