XTHCDEM.m

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 ---XTHCDEM   1330     printed  Feb 19, 2025@00:07:29                                                                                                                                                                                                     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       ;