| 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 | 
|---|