XTHCDEM ;HCIOFO/SG - HTTP 1.0 CLIENT (DEMO) ;11/05/09 17:19
;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 4
;
;##### DEMO ENTRY POINT
;
; The ^TMP($J,"XTHC") global node is used by the entry point.
;
DEMO ;
N BODY,DIR,DIRUT,DTOUT,DUOUT,HEADER,RC,URL,X,Y
S BODY=$NA(^TMP($J,"XTHC"))
S URL="http://www.hardhats.org"
;
S RC=0
F D Q:RC
. K @BODY,HEADER W !
. ;--- Request a URL from the user
. K DIR S DIR(0)="F"
. S DIR("A")="URL",DIR("B")=URL
. D ^DIR I $D(DIRUT) S RC=1 Q
. S URL=$$TRIM^XLFSTR(Y)
. ;--- Request the resource
. S RC=$$GETURL^XTHC10(URL,,BODY,.HEADER)
. I RC<0 W !,RC S RC=0 Q ; D PRTERRS^XTERROR1(RC) S RC=0 Q
. ;--- Print the data
. D PRINT(BODY,.HEADER)
. S RC=0
;
;--- Cleanup
K @BODY
Q
;
;+++++ PRINTS THE RESPONSE
PRINT(XTHC8DAT,HEADER) ;
N I,J
;---
I $D(HEADER)>0 D Q:$$PAGE
. W @IOF,"----- HTTP HEADER -----",!!
. W $G(HEADER),!
. S I=""
. F S I=$O(HEADER(I)) Q:I="" W I_"="_HEADER(I),!
;---
D:$D(@XTHC8DAT)>1
. W @IOF,"----- MESSAGE XTHC8DAT -----",!!
. S I=""
. F S I=$O(@XTHC8DAT@(I)) Q:I="" W @XTHC8DAT@(I) D W !
. . S J="" F S J=$O(@XTHC8DAT@(I,J)) Q:J="" W @XTHC8DAT@(I,J)
Q
;
PAGE() ;Page break
N DIR,DIROUT,DTOUT,DUOUT
S DIR(0)="E"
D ^DIR
Q $S($D(DUOUT):1,$D(DTOUT):1,1:0)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTHCDEM 1330 printed Dec 13, 2024@02:41:02 Page 2
XTHCDEM ;HCIOFO/SG - HTTP 1.0 CLIENT (DEMO) ;11/05/09 17:19
+1 ;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 4
+2 ;
+3 ;##### DEMO ENTRY POINT
+4 ;
+5 ; The ^TMP($J,"XTHC") global node is used by the entry point.
+6 ;
DEMO ;
+1 NEW BODY,DIR,DIRUT,DTOUT,DUOUT,HEADER,RC,URL,X,Y
+2 SET BODY=$NAME(^TMP($JOB,"XTHC"))
+3 SET URL="http://www.hardhats.org"
+4 ;
+5 SET RC=0
+6 FOR
Begin DoDot:1
+7 KILL @BODY,HEADER
WRITE !
+8 ;--- Request a URL from the user
+9 KILL DIR
SET DIR(0)="F"
+10 SET DIR("A")="URL"
SET DIR("B")=URL
+11 DO ^DIR
IF $DATA(DIRUT)
SET RC=1
QUIT
+12 SET URL=$$TRIM^XLFSTR(Y)
+13 ;--- Request the resource
+14 SET RC=$$GETURL^XTHC10(URL,,BODY,.HEADER)
+15 ; D PRTERRS^XTERROR1(RC) S RC=0 Q
IF RC<0
WRITE !,RC
SET RC=0
QUIT
+16 ;--- Print the data
+17 DO PRINT(BODY,.HEADER)
+18 SET RC=0
End DoDot:1
if RC
QUIT
+19 ;
+20 ;--- Cleanup
+21 KILL @BODY
+22 QUIT
+23 ;
+24 ;+++++ PRINTS THE RESPONSE
PRINT(XTHC8DAT,HEADER) ;
+1 NEW I,J
+2 ;---
+3 IF $DATA(HEADER)>0
Begin DoDot:1
+4 WRITE @IOF,"----- HTTP HEADER -----",!!
+5 WRITE $GET(HEADER),!
+6 SET I=""
+7 FOR
SET I=$ORDER(HEADER(I))
if I=""
QUIT
WRITE I_"="_HEADER(I),!
End DoDot:1
if $$PAGE
QUIT
+8 ;---
+9 if $DATA(@XTHC8DAT)>1
Begin DoDot:1
+10 WRITE @IOF,"----- MESSAGE XTHC8DAT -----",!!
+11 SET I=""
+12 FOR
SET I=$ORDER(@XTHC8DAT@(I))
if I=""
QUIT
WRITE @XTHC8DAT@(I)
Begin DoDot:2
+13 SET J=""
FOR
SET J=$ORDER(@XTHC8DAT@(I,J))
if J=""
QUIT
WRITE @XTHC8DAT@(I,J)
End DoDot:2
WRITE !
End DoDot:1
+14 QUIT
+15 ;
PAGE() ;Page break
+1 NEW DIR,DIROUT,DTOUT,DUOUT
+2 SET DIR(0)="E"
+3 DO ^DIR
+4 QUIT $SELECT($DATA(DUOUT):1,$DATA(DTOUT):1,1:0)
+5 ;
