Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTHC10

XTHC10.m

Go to the documentation of this file.
  1. XTHC10 ;HCIOFO/SG - HTTP 1.0 CLIENT ;12/07/2011
  1. ;;7.3;TOOLKIT;**123,566**;Apr 25, 1995;Build 6
  1. ;
  1. Q
  1. ;
  1. ;##### GETS THE DATA FROM THE PROVIDED URL USING HTTP 1.0
  1. ;
  1. ; URL URL (http://host:port/path)
  1. ;
  1. ; [XT8FLG] Timeout and flags to control processing.
  1. ; If a value of this parameter starts from a number
  1. ; then this number is used as a value of the timeout
  1. ; (in seconds). Otherwise, the default value of 5
  1. ; seconds is used.
  1. ;
  1. ; [XT8RDAT] Closed root of the variable where the message
  1. ; body is returned. Data is stored in consecutive
  1. ; nodes (numbers starting from 1). If a line is
  1. ; longer than 245 characters, only 245 characters
  1. ; are stored in the corresponding node. After that,
  1. ; overflow sub-nodes are created. For example:
  1. ;
  1. ; @XT8DATA@(1)="<html>"
  1. ; @XT8DATA@(2)="<head><title>VistA</title></head>"
  1. ; @XT8DATA@(3)="<body>"
  1. ; @XT8DATA@(4)="<p>"
  1. ; @XT8DATA@(5)="Beginning of a very long line"
  1. ; @XT8DATA@(5,1)="Continuation #1 of the long line"
  1. ; @XT8DATA@(5,2)="Continuation #2 of the long line"
  1. ; @XT8DATA@(5,...)=...
  1. ; @XT8DATA@(6)="</p>"
  1. ; ...
  1. ;
  1. ; [.XT8RHDR] Reference to a local variable where the parsed
  1. ; headers are returned. Header names are converted to
  1. ; upper case; the values are left "as is". The root
  1. ; node contains the status line. For example:
  1. ;
  1. ; XT8HDR="HTTP/1.0 200 OK"
  1. ; XT8HDR("CACHE-CONTROL")="private"
  1. ; XT8HDR("CONNECTION")="Keep-Alive"
  1. ; XT8HDR("CONTENT-LENGTH")="2690"
  1. ; XT8HDR("CONTENT-TYPE")="text/html"
  1. ; XT8HDR("DATE")="Fri, 26 Sep 2003 16:04:10 GMT"
  1. ; XT8HDR("SERVER")="GWS/2.1"
  1. ;
  1. ; [XT8SDAT] Closed root of a variable containing body of the
  1. ; request message. Data should be formatted as
  1. ; described earlier (see the XT8RDAT parameter).
  1. ;
  1. ; NOTE: If this parameter is defined, not empty, and
  1. ; the referenced array contains data then the
  1. ; POST request is generated. Otherwise, the GET
  1. ; request is sent.
  1. ;
  1. ; [.XT8SHDR] Reference to a local variable containing header
  1. ; values, which will be added to the request.
  1. ;
  1. ; [REDIR] This IS NOT a published parameter. It is used
  1. ; internally to limit number of redirections.
  1. ;
  1. ; Return values:
  1. ;
  1. ; <0 Error Descriptor (see the $$ERROR^XTERROR)
  1. ; >0 HTTP Status Code^Description
  1. ;
  1. ; Most common HTTP status codes:
  1. ;
  1. ; 200 Ok
  1. ;
  1. ; 301 Moved Permanently (The application should either
  1. ; automatically update the URL with the new one from
  1. ; the Location response header or instruct the user
  1. ; how to do this).
  1. ;
  1. ; 302 Moved Temporarily (The application should continue
  1. ; using the original URL).
  1. ;
  1. ; NOTE: You will not see this code for GET requests.
  1. ; They are redirected automatically.
  1. ;
  1. ; 303 See Other (The resource has moved to another URL
  1. ; given by the Location response header, and should
  1. ; be automatically retrieved by the client using the
  1. ; GET method. This is often used by a CGI script to
  1. ; redirect the client to an existing file).
  1. ;
  1. ; NOTE: You will not see this status code because it
  1. ; is handled automatically inside the function.
  1. ;
  1. ; 400 Bad Request
  1. ;
  1. ; 404 Not Found
  1. ;
  1. ; 500 Server Error (An unexpected server error. The most
  1. ; common cause is a server-side script that has bad
  1. ; syntax, fails, or otherwise can't run correctly).
  1. ;
  1. ; See the http://www.faqs.org/rfcs/rfc1945.html for more details.
  1. ;
  1. GETURL(URL,XT8FLG,XT8RDAT,XT8RHDR,XT8SDAT,XT8SHDR,REDIR) ;
  1. N HOST,I,IP,IPADDR,PATH,PORT,RQS,STATUS,X
  1. ;**P566 START CJM
  1. N IO,POP
  1. ;**P566 END CJM
  1. S XT8FLG=$G(XT8FLG) S:XT8FLG'?1.N.E XT8FLG="5"_XT8FLG
  1. ;
  1. ;Check IO
  1. I '$D(IO(0)) D HOME^%ZIS
  1. ;=== Parse the URL
  1. S I=$$PARSEURL^XTHCURL(URL,.HOST,.PORT,.PATH) Q:I<0 I
  1. ;
  1. ;=== Check the host name/address
  1. I HOST'?1.3N3(1"."1.3N) D Q:IPADDR="" $$ERROR(2,HOST)
  1. . ;--- Resolve the host name into the IP address(es)
  1. . S IPADDR=$$ADDRESS^XLFNSLK(HOST) Q:IPADDR=""
  1. . ;--- Check for the Host header value
  1. . S I=""
  1. . F S I=$O(XT8SHDR(I)) Q:(I="")!($$UP^XLFSTR(I)="HOST")
  1. . S:I="" XT8SHDR("Host")=HOST
  1. E S IPADDR=HOST
  1. ;
  1. ;=== Connect to the host
  1. F I=1:1 S IP=$P(IPADDR,",",I) Q:IP="" D Q:'$G(POP)
  1. . D CALL^%ZISTCP(IP,PORT,+XT8FLG)
  1. Q:$G(POP) $$ERROR(3,IPADDR)
  1. ;
  1. ;=== Perform the transaction
  1. D
  1. . N $ESTACK,$ETRAP
  1. . ;--- Setup the error processing
  1. . ;D SETDEFEH^XTERROR("STATUS")
  1. . S $ET="D ETRAP^XTHC10"
  1. . ;--- Send the request and get the response
  1. . S RQS=$$REQUEST^XTHC10A(PATH,$G(XT8SDAT),.XT8SHDR)
  1. . I RQS<0 S STATUS=RQS Q
  1. . S STATUS=$$RECEIVE^XTHC10A(+XT8FLG,$G(XT8RDAT),.XT8RHDR)
  1. ;
  1. ;=== Close the socket
  1. D CLOSE^%ZISTCP
  1. ;
  1. ;=== Redirect if requested by the server
  1. S I=+STATUS
  1. I (I\100)=3 D:$S(I=303:1,I=301:0,1:RQS="GET")
  1. . I $G(REDIR)>5 S STATUS=$$ERROR(5) Q
  1. . S URL=$G(XT8RHDR("LOCATION"))
  1. . ;I URL="" S STATUS=$$ERROR^XTERROR(-150000.024) Q
  1. . I URL="" S STATUS=$$ERROR(4) Q
  1. . I RQS="POST" N XT8SDAT ; Force the GET request
  1. . S STATUS=$$GETURL(URL,XT8FLG,$G(XT8RDAT),.XT8RHDR,$G(XT8SDAT),.XT8SHDR,$G(REDIR)+1)
  1. ;
  1. ;=== Return the status
  1. ;I +STATUS=-150000.004 S X=$$LASTERR^XTERROR1() S:X STATUS=X
  1. I +STATUS=-6 S STATUS=STATUS("ERROR")
  1. Q STATUS
  1. ;
  1. ETRAP ;Catch a runtime error
  1. N EC
  1. S STATUS("ERROR")=$$EC^%ZOSV D ^%ZTER
  1. S STATUS=-6
  1. I $L($EC) S $ECODE="" S $ETRAP="D UNW^%ZTER Q:$QUIT STATUS Q " S $ECODE=",U1,"
  1. Q
  1. ;
  1. ERROR(ENUM,PARAM) ;Expand error
  1. N MSG
  1. S MSG=$P($T(@ENUM),";;",2) S:MSG["|" MSG=$P(MSG,"|")_$G(PARAM)_$P(MSG,"|",2)
  1. Q MSG
  1. ;
  1. 1 ;;-1^Missing host name.
  1. 2 ;;-1^Cannot resolve the host name: |.
  1. 3 ;;-1^Cannot connect to host.
  1. 4 ;;-1^Missing redirection URL.
  1. 5 ;;-1^Too many redirections.
  1. 6 ;;-6^Run Time Error.
  1. 7 ;;-1^Time Out.