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