[613] | 1 | ONCXURL ;HCIOFO/SG - HTTP AND WEB SERVICES (URL TOOLS) ; 5/14/04 11:00am
|
---|
| 2 | ;;2.11;ONCOLOGY;**40**;Mar 07, 1995
|
---|
| 3 | ;
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | ;***** CREATES URL FROM COMPONENTS
|
---|
| 7 | ;
|
---|
| 8 | ; HOST Host name
|
---|
| 9 | ; [PORT] Port number (80, by default)
|
---|
| 10 | ; [PATH] Resource path ("/", by default)
|
---|
| 11 | ;
|
---|
| 12 | ; [.QUERY] Reference to a local variable containing values of
|
---|
| 13 | ; the query parameters: QUERY(Name)=Value.
|
---|
| 14 | ;
|
---|
| 15 | ; Return values:
|
---|
| 16 | ; <0 Error Descriptor
|
---|
| 17 | ; ... Resulting URL
|
---|
| 18 | ;
|
---|
| 19 | CREATE(HOST,PORT,PATH,QUERY) ;
|
---|
| 20 | N NAME,QSTR,VAL
|
---|
| 21 | S:HOST'["://" HOST="http://"_HOST
|
---|
| 22 | S PORT=$S($G(PORT)>0:":"_(+PORT),1:"")
|
---|
| 23 | ;---
|
---|
| 24 | S (NAME,QSTR)=""
|
---|
| 25 | F S NAME=$O(QUERY(NAME)) Q:NAME="" D
|
---|
| 26 | . S VAL=$G(QUERY(NAME))
|
---|
| 27 | . S QSTR=QSTR_"&"_$$ENCODE(NAME)_"="_$$ENCODE(VAL)
|
---|
| 28 | S:QSTR'="" $E(QSTR,1)="?"
|
---|
| 29 | ;---
|
---|
| 30 | Q HOST_PORT_$$PATH($G(PATH)_QSTR)
|
---|
| 31 | ;
|
---|
| 32 | ;***** ENCODES THE STRING
|
---|
| 33 | ;
|
---|
| 34 | ; STR String to be encoded
|
---|
| 35 | ;
|
---|
| 36 | ENCODE(STR) ;
|
---|
| 37 | N CH,I
|
---|
| 38 | F I=1:1 S CH=$E(STR,I) Q:CH="" I CH?1CP D
|
---|
| 39 | . I CH=" " S $E(STR,I)="+" Q
|
---|
| 40 | . S $E(STR,I)="%"_$$RJ^XLFSTR($$CNV^XLFUTL($A(CH),16),2,"0"),I=I+2
|
---|
| 41 | Q STR
|
---|
| 42 | ;
|
---|
| 43 | ;***** PARSES THE URL INTO COMPONENTS
|
---|
| 44 | ;
|
---|
| 45 | ; URL Source URL
|
---|
| 46 | ;
|
---|
| 47 | ; .HOST Reference to a local variable for the host name
|
---|
| 48 | ; .PORT Reference to a local variable for the port number
|
---|
| 49 | ; .PATH Reference to a local variable for the path
|
---|
| 50 | ;
|
---|
| 51 | ; Return values:
|
---|
| 52 | ; <0 Error Descriptor
|
---|
| 53 | ; 0 Ok
|
---|
| 54 | ;
|
---|
| 55 | PARSE(URL,HOST,PORT,PATH) ;
|
---|
| 56 | S:$F(URL,"://") URL=$P(URL,"://",2,999)
|
---|
| 57 | S HOST=$TR($P(URL,"/")," ")
|
---|
| 58 | S PATH=$$PATH($P(URL,"/",2,999))
|
---|
| 59 | S PORT=$P(HOST,":",2),HOST=$P(HOST,":")
|
---|
| 60 | Q:HOST?." " $$ERROR^ONCXERR(-1,,URL)
|
---|
| 61 | S:PORT'>0 PORT=80
|
---|
| 62 | Q 0
|
---|
| 63 | ;
|
---|
| 64 | ;***** DEFAULT PATH PROCESSING (NORMALIZATION)
|
---|
| 65 | ;
|
---|
| 66 | ; PATH Source path
|
---|
| 67 | ;
|
---|
| 68 | PATH(PATH) ;
|
---|
| 69 | N LAST
|
---|
| 70 | ;--- Make sure the path has a leading slash if it
|
---|
| 71 | ;--- is not empty and has no query string
|
---|
| 72 | I $E(PATH,1)'="/" S:$E(PATH,1)'="?" PATH="/"_PATH
|
---|
| 73 | ;--- Append a trailing slash to the path if it has
|
---|
| 74 | ;--- neither a file name nor a query string
|
---|
| 75 | S LAST=$L(PATH,"/"),LAST=$P(PATH,"/",LAST)
|
---|
| 76 | I LAST'="",LAST'["?",LAST'["." S PATH=PATH_"/"
|
---|
| 77 | Q PATH
|
---|