XTHCURL ;HCIOFO/SG - HTTP 1.0 CLIENT (URL TOOLS) ;07/29/10 14:01
;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 5
;Per VHA Directive 2004-038, this routine should not be modified
Q
;
;***** ENCODES THE STRING
;
; STR String to be encoded
;
ENCODE(STR) ;
N CH,I
F I=1:1 S CH=$E(STR,I) Q:CH="" I CH?1CP D
. I CH="." Q
. I CH=" " S $E(STR,I)="+" Q
. S $E(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($A(CH),16),2,"0"),I=I+2
Q STR
;
;##### CREATES URL FROM COMPONENTS
;
; HOST Host name
; [PORT] Port number (80, by default)
; [PATH] Resource path ("/", by default)
;
; [.QUERY] Reference to a local variable containing values of
; the query parameters: QUERY(Name)=Value.
;
; Return values:
; <0 Error Descriptor
; ... Resulting URL
;
MAKEURL(HOST,PORT,PATH,QUERY) ;
N NAME,QSTR,VAL
S:HOST'["://" HOST="http://"_HOST
S PORT=$S($G(PORT)>0:":"_(+PORT),1:"")
;---
S (NAME,QSTR)=""
F S NAME=$O(QUERY(NAME)) Q:NAME="" D
. S VAL=$G(QUERY(NAME))
. S QSTR=QSTR_"&"_$$ENCODE(NAME)_"="_$$ENCODE(VAL)
S:QSTR'="" $E(QSTR,1)="?"
;---
S:$G(PATH)="" PATH="/"
Q HOST_PORT_$$NORMPATH($G(PATH)_QSTR)
;
;##### RETURNS "NORMALIZED" PATH
;
; PATH Source path
;
NORMPATH(PATH) ;
N LAST
;--- Make sure the path has a leading slash if it
;--- is not empty and has no query string
I $E(PATH,1)'="/" S:$E(PATH,1)'="?" PATH="/"_PATH
;--- Append a trailing slash to the path if it has
;--- neither a file name nor a query string
S LAST=$L(PATH,"/"),LAST=$P(PATH,"/",LAST)
I LAST'="",LAST'["?",LAST'["." S PATH=PATH_"/"
Q PATH
;
;##### PARSES THE URL INTO COMPONENTS
;
; URL Source URL
;
; .HOST Reference to a local variable for the host name
; .PORT Reference to a local variable for the port number
; .PATH Reference to a local variable for the path
;
; Return values:
; <0 Error Descriptor
; 0 Ok
;
PARSEURL(URL,HOST,PORT,PATH) ;
S:$F(URL,"://") URL=$P(URL,"://",2,999)
S HOST=$TR($P(URL,"/")," ")
S PATH=$$NORMPATH($P(URL,"/",2,999))
S PORT=$P(HOST,":",2),HOST=$P(HOST,":")
Q:HOST?." " $$ERROR^XTHC10(1,URL)
S:PORT'>0 PORT=80
Q 0
XTHCURL ;HCIOFO/SG - HTTP 1.0 CLIENT (URL TOOLS) ;07/29/10 14:01
+1 ;;7.3;TOOLKIT;**123**;Apr 25, 1995;Build 5
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
+5 ;***** ENCODES THE STRING
+6 ;
+7 ; STR String to be encoded
+8 ;
ENCODE(STR) ;
+1 NEW CH,I
+2 FOR I=1:1
SET CH=$EXTRACT(STR,I)
IF CH=""
QUIT
IF CH?1CP
Begin DoDot:1
+3 IF CH="."
QUIT
+4 IF CH=" "
SET $EXTRACT(STR,I)="+"
QUIT
+5 SET $EXTRACT(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($ASCII(CH),16),2,"0")
SET I=I+2
End DoDot:1
+6 QUIT STR
+7 ;
+8 ;##### CREATES URL FROM COMPONENTS
+9 ;
+10 ; HOST Host name
+11 ; [PORT] Port number (80, by default)
+12 ; [PATH] Resource path ("/", by default)
+13 ;
+14 ; [.QUERY] Reference to a local variable containing values of
+15 ; the query parameters: QUERY(Name)=Value.
+16 ;
+17 ; Return values:
+18 ; <0 Error Descriptor
+19 ; ... Resulting URL
+20 ;
MAKEURL(HOST,PORT,PATH,QUERY) ;
+1 NEW NAME,QSTR,VAL
+2 IF HOST'["
SET HOST="http://"_HOST
+3 SET PORT=$SELECT($GET(PORT)>0:":"_(+PORT),1:"")
+4 ;---
+5 SET (NAME,QSTR)=""
+6 FOR
SET NAME=$ORDER(QUERY(NAME))
IF NAME=""
QUIT
Begin DoDot:1
+7 SET VAL=$GET(QUERY(NAME))
+8 SET QSTR=QSTR_"&"_$$ENCODE(NAME)_"="_$$ENCODE(VAL)
End DoDot:1
+9 IF QSTR'=""
SET $EXTRACT(QSTR,1)="?"
+10 ;---
+11 IF $GET(PATH)=""
SET PATH="/"
+12 QUIT HOST_PORT_$$NORMPATH($GET(PATH)_QSTR)
+13 ;
+14 ;##### RETURNS "NORMALIZED" PATH
+15 ;
+16 ; PATH Source path
+17 ;
NORMPATH(PATH) ;
+1 NEW LAST
+2 ;--- Make sure the path has a leading slash if it
+3 ;--- is not empty and has no query string
+4 IF $EXTRACT(PATH,1)'="/"
IF $EXTRACT(PATH,1)'="?"
SET PATH="/"_PATH
+5 ;--- Append a trailing slash to the path if it has
+6 ;--- neither a file name nor a query string
+7 SET LAST=$LENGTH(PATH,"/")
SET LAST=$PIECE(PATH,"/",LAST)
+8 IF LAST'=""
IF LAST'["?"
IF LAST'["."
SET PATH=PATH_"/"
+9 QUIT PATH
+10 ;
+11 ;##### PARSES THE URL INTO COMPONENTS
+12 ;
+13 ; URL Source URL
+14 ;
+15 ; .HOST Reference to a local variable for the host name
+16 ; .PORT Reference to a local variable for the port number
+17 ; .PATH Reference to a local variable for the path
+18 ;
+19 ; Return values:
+20 ; <0 Error Descriptor
+21 ; 0 Ok
+22 ;
PARSEURL(URL,HOST,PORT,PATH) ;
+1 IF $FIND(URL,"
SET URL=$PIECE(URL,"://",2,999)
+2 SET HOST=$TRANSLATE($PIECE(URL,"/")," ")
+3 SET PATH=$$NORMPATH($PIECE(URL,"/",2,999))
+4 SET PORT=$PIECE(HOST,":",2)
SET HOST=$PIECE(HOST,":")
+5 IF HOST?." "
QUIT $$ERROR^XTHC10(1,URL)
+6 IF PORT'>0
SET PORT=80
+7 QUIT 0
