source: IHS-VA_UTILITIES-XB/ZIBRPI.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 15 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 5.8 KB
Line 
1ZIBRPI ; IHS/ADC/GTH - REMOTE PATCH INSTALLATION ; [ 11/04/97 10:26 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
4 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
5 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
6 ;
7 ; For a description of this utility, see the text in routine
8 ; ZIBRPI2.
9 ;
10 ; D = Directory containing patch files
11 ; D("OUT") = Directory with results files
12 ; E = "Action" routine, named (A/B)9<namespace><patch_number>
13 ; F = Name of a file containing a patch
14 ; J = Today's Julian date
15 ; L = Facility's Pseudo Prefix
16 ; N = Namespace derived from the name of the file
17 ; O = Operating System, and OS-specific commands
18 ; P = PACKAGE file IEN
19 ; V = Version derived from the name of the file
20 ; W = Work file
21 ;
22 W !!,"EXECUTION UNAUTHORIZED.",!
23 Q
24 ;
25OPT ;EP - Set option in OPTION file. Called by a programmer.
26 D OPT^ZIBRPI1
27 Q
28 ;
29START ;EP - From TaskMan.
30 NEW %ZIS,D,DA,DIC,E,F,I,J,L,N,O,P,POP,V,W,XMSUB,XMTEXT,XMY
31 D HFS
32 Q:POP
33 D OS
34 KILL ^TMP($J)
35 ; rm xmit files over 2 weeks old.
36 S L=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),1),U,2) I '($L(L)=3) S L="RPI"
37 D HC(O("LS")_D("OUT")_O("NS")_L_".* > "_W)
38 S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
39 D ZIS,JDT
40 U IO
41 ; Comment next line to keep xmit ("rpi") files over 2 wks old.
42 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")_%)
43 D HC(O("RM")_W)
44 ; Initialize namespace, systems, and frequency.
45 S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),D=$P($P(^(20),"""",2),U)
46 S:'("/\"[$E(D,$L(D))) D=D_$S(O["UNIX":"/",1:"\")
47 D HC(O("LS")_D_"*.*"_" > "_W)
48 S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
49 D ZIS
50 U IO
51 ; The Q:%="" in the following line is non-standard MUMPS.
52 F R %:300 Q:%="" S %=$P(%,"/",$L(%,"/")) I %?@O("PF") S ^TMP($J,"ZIBRPI",%)=""
53 S F=""
54 I '$L($O(^TMP($J,"ZIBRPI",""))) D ZISC D HC(O("RM")_W) KILL ^TMP($J) S:$D(ZTQUEUED) ZTREQ="@" Q
55MAIN ;
56 F S F=$O(^TMP($J,"ZIBRPI",F)) Q:F="" D S ^TMP($J,"ZIBRPI",F)=% D:%="INSTALLED" HC(O("RM")_D_F)
57 . S X=$E(F,1,4),X=$P(X,"_"),N=$$UP^XLFSTR(X)
58 . I '$D(^DIC(9.4,"C",N)) S %="FAILED - Not an Installed Package" Q
59 . S P=$O(^DIC(9.4,"C",N,0))
60 . I 'P S %="FAILED - Bad ""C"" x-ref for "_N Q
61 . I '$D(^DIC(9.4,P,"VERSION")) S %="FAILED - 'VERSION' Node Missing" Q
62 . S V=+($E(F,5,6)_"."_$E(F,7,8))
63 . I (+V)'=(+^DIC(9.4,P,"VERSION")) S %="FAILED - V "_^("VERSION")_" of "_N_" is Installed" Q
64 . ; 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.
65 . 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.
66 . U IO:(D_F)
67 . R %:300
68 . R %:300
69 . ; The ZL and ZS in the following line are non-standard M commands.
70 . F R %:300 Q:%="" S:%=E ^TMP($J,"B9",%)="" X "ZL ZS @%"
71 . 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))
72 . I 'DA(1) S DA(1)=$P(^DIC(9.4,P,22,0),U,3)
73 . S:'$D(^DIC(9.4,P,22,DA(1),"PAH",0)) ^(0)="^9.4901^^"
74 . ; 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.
75 . 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.
76 . D FILE
77 . S %="INSTALLED"
78 . Q
79ENDMAIN ;
80 D OS
81 S %=0,F="",D=D("OUT")_O("NS")_L_"."_J
82 U IO:(D:"W")
83 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)
84 U IO:(W)
85 D ZISC,HC(O("RM")_W)
86 ; uucp according to parameter: ENTRY ACTION of option.
87 S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),E=$P($P(^(20),"""",2),U,2)
88 I O["UNIX" D
89 . I '(%=2) D HC("uucp -r "_D_" "_$P($T(SYTM),";",3)_"!~")
90 . I %>1 D HC("uucp -r -nroot "_D_" "_$P(^AUTTSITE(1,0),U,14)_"!~")
91 . Q
92 S XMTEXT="XMTEXT(",XMSUB=$P($P($T(ZIBRPI),";",2),"-",2),XMY(1)=""
93 D XMD
94 I E S %="" F S %=$O(^TMP($J,"B9",%)) Q:%="" D RTN(U_%)
95 KILL ^TMP($J)
96 S ZTREQ="@"
97Q ;
98 Q
99 ;
100DIE NEW D,E,F,I,J,L,N,O,P,V,W D ^DIE Q
101DIR NEW D,E,F,I,J,L,N,O,P,V,W D ^DIR Q
102DTC NEW D,E,F,I,J,L,N,O,P,V,W D ^%DTC Q
103FILE NEW D,E,F,I,J,L,N,O,P,V,W KILL DD,DO D FILE^DICN Q
104HC(%) NEW D,E,F,I,J,L,N,O,P,V,W S %=$$JOBWAIT^%HOSTCMD(%) Q
105RTN(%) NEW D,E,F,I,J,L,N,O,P,V,W D @(%) Q
106XMD NEW D,E,F,I,J,L,N,O,P,V,W D ^XMD Q
107ZIS NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZIS Q
108ZISC NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZISC Q
109 ;
110HFS ;
111 ; 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.
112 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.
113 I 'I,'$D(POP) S POP=1
114 Q:POP
115 S I=$P(^%ZIS(1,I,0),U)
116 Q
117 ;
118JDT ;
119 NEW X1,X2
120 S X2=$E(DT,1,3)_"0101",X1=DT
121 D DTC
122 S X=X+1,X="00"_X,J=$E(X,$L(X)-2,$L(X))
123 Q
124 ;
125OS ; The "IN" directory is retrieved from the OPTION entry.
126 S O=$P($P(^%ZOSF("OS"),","),"-",2),O("PF")=$P($T(PATTERN),";",3)
127 S W=$P($T(WORK),";",3),O("NS")=$P($T(NS),";",3)
128 I O["UNIX" S (D("IN"),D("OUT"))=$P($T(PUB),";",3),O("RM")="rm ",O("LS")="ls -l ",W=D("OUT")_W Q
129 S %=$G(^AUTTSITE(1,1)),D("IN")=$P(%,U),D("OUT")=$P(%,U,2),O("RM")="DEL ",O("LS")="DIR /B "
130 Q
131 ;
132 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
133 ; Old PATTERN:
134 ;;2.4L.2"_"4N1"."1"p"1.2N
135SYTM ;;dpssyg
136PATTERN ;;2.4L.2"_"4N1"."1.2N1"p"; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
137WORK ;;ZIBRPI.WRK
138PUB ;;/usr/spool/uucppublic/
139NS ;;ZIB_P
Note: See TracBrowser for help on using the repository browser.