ONCXURL ;HCIOFO/SG - HTTP AND WEB SERVICES (URL TOOLS) ; 5/14/04 11:00am
;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
;
Q
;
;***** 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
;
CREATE(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)="?"
;---
Q HOST_PORT_$$PATH($G(PATH)_QSTR)
;
;***** 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=" " S $E(STR,I)="+" Q
. S $E(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($A(CH),16),2,"0"),I=I+2
Q STR
;
;***** 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
;
PARSE(URL,HOST,PORT,PATH) ;
S:$F(URL,"://") URL=$P(URL,"://",2,999)
S HOST=$TR($P(URL,"/")," ")
S PATH=$$PATH($P(URL,"/",2,999))
I HOST["." D
.S PORT=$P(HOST,":",2),HOST=$P(HOST,":")
E S PORT=$P(HOST,"]:",2),HOST=$P($P(HOST,"]:"),"[",2)
Q:HOST?." " $$ERROR^ONCXERR(-1,,URL)
S:PORT'>0 PORT=80
Q 0
;
;***** DEFAULT PATH PROCESSING (NORMALIZATION)
;
; PATH Source path
;
PATH(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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCXURL 2256 printed Apr 09, 2024@21:25:10 Page 2
ONCXURL ;HCIOFO/SG - HTTP AND WEB SERVICES (URL TOOLS) ; 5/14/04 11:00am
+1 ;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
+2 ;
+3 QUIT
+4 ;
+5 ;***** CREATES URL FROM COMPONENTS
+6 ;
+7 ; HOST Host name
+8 ; [PORT] Port number (80, by default)
+9 ; [PATH] Resource path ("/", by default)
+10 ;
+11 ; [.QUERY] Reference to a local variable containing values of
+12 ; the query parameters: QUERY(Name)=Value.
+13 ;
+14 ; Return values:
+15 ; <0 Error Descriptor
+16 ; ... Resulting URL
+17 ;
CREATE(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 QUIT HOST_PORT_$$PATH($GET(PATH)_QSTR)
+12 ;
+13 ;***** ENCODES THE STRING
+14 ;
+15 ; STR String to be encoded
+16 ;
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=" "
SET $EXTRACT(STR,I)="+"
QUIT
+4 SET $EXTRACT(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($ASCII(CH),16),2,"0")
SET I=I+2
End DoDot:1
+5 QUIT STR
+6 ;
+7 ;***** PARSES THE URL INTO COMPONENTS
+8 ;
+9 ; URL Source URL
+10 ;
+11 ; .HOST Reference to a local variable for the host name
+12 ; .PORT Reference to a local variable for the port number
+13 ; .PATH Reference to a local variable for the path
+14 ;
+15 ; Return values:
+16 ; <0 Error Descriptor
+17 ; 0 Ok
+18 ;
PARSE(URL,HOST,PORT,PATH) ;
+1 if $FIND(URL,"
SET URL=$PIECE(URL,"://",2,999)
+2 SET HOST=$TRANSLATE($PIECE(URL,"/")," ")
+3 SET PATH=$$PATH($PIECE(URL,"/",2,999))
+4 IF HOST["."
Begin DoDot:1
+5 SET PORT=$PIECE(HOST,":",2)
SET HOST=$PIECE(HOST,":")
End DoDot:1
+6 IF '$TEST
SET PORT=$PIECE(HOST,"]:",2)
SET HOST=$PIECE($PIECE(HOST,"]:"),"[",2)
+7 if HOST?." "
QUIT $$ERROR^ONCXERR(-1,,URL)
+8 if PORT'>0
SET PORT=80
+9 QUIT 0
+10 ;
+11 ;***** DEFAULT PATH PROCESSING (NORMALIZATION)
+12 ;
+13 ; PATH Source path
+14 ;
PATH(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
