source: fmts/trunk/p/C0XGET2.m@ 1703

Last change on this file since 1703 was 1634, checked in by George Lilly, 11 years ago

bug fix for bnf project
File size: 7.0 KB
Line 
1C0XGET1 ; GPL - Fileman Triples entry point routine ;1/12/12 17:05
2 ;;0.1;C0X;nopatch;noreleasedate;Build 7
3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21 ;
22LSSUBJ(RTN,ZSUBJ,C0XFARY) ; LIST NODES WITH SUBJECT ZSUBJ
23 ;
24 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
25 D USEFARY^C0XF2N("C0XFARY")
26 Q
27 ;
28GRAPHS(RTN,C0XFARY) ; LIST ALL GRAPHS
29 ;
30 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
31 D USEFARY^C0XF2N("C0XFARY")
32 N ZI S ZI=""
33 F S ZI=$O(@C0XTN@("G",ZI)) Q:ZI="" D ;
34 . S RTN(ZI,$$STR(ZI))=""
35 Q
36 ;
37STR(ZIN,C0XFARY) ; EXTRINSIC RETURNS A STRING
38 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
39 Q $$GET1^DIQ(C0XSFN,ZIN,.01,"E")
40 ;
41SPO(ZRTN,ZNODE,C0XFARY)
42 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
43 N ZI S ZI=$$NXT(.ZRTN)
44 S ZRTN(ZI,"S")=$$S(ZNODE)
45 S ZRTN(ZI,"P")=$$P(ZNODE)
46 S ZRTN(ZI,"O")=$$O(ZNODE)
47 Q
48 ;
49S(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE SUBJECT
50 Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.03,"I")) ;
51 ;
52P(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE PREDICATE
53 Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.04,"I")) ;
54 ;
55O(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE OBJECT
56 Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.05,"I")) ;
57 ;
58NXT(ZRTN) ;EXTRINSIC FOR THE NEXT NODE IN ARRAY ZRTN, PASSED BY REF
59 I '$D(ZRTN) S ZRTN=""
60 Q $O(ZRTN(""),-1)+1
61 ;
62SING(ZRTN,ZG) ; SUBJECTS IN GRAPH
63 ;
64 I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
65 I '$D(ZRTN) S ZRTN=""
66 N ZI,ZN S ZI=""
67 F S ZI=$O(@C0XTN@("GSPO",ZG,ZI)) Q:ZI="" D ;
68 . S ZRTN($$NXT(.ZRTN),"S")=$$STR(ZI)
69 Q
70 ;
71qparse(qrtn,zquery) ; parses the query
72 ; want this to be able to handle the WHERE clause of SPARQL eventually
73 ;
74 n q1,q2,q3,qq
75 ;s qq=$tr(zquery," ","^")
76 s qq=zquery ; really want to remove whitespace here
77 s q1=$p(qq," ",1)
78 i q1["?" s q1=""
79 s q2=$p(qq," ",2)
80 i q2["?" s q2=""
81 s q3=$p(qq," ",3)
82 i q3["?" s q3=""
83 s qrtn(1)=q1_"^"_q2_"^"_q3 ; more lines to come later
84 q
85 ;
86rpctrip(rtn,query,limit,offset) ; rpc to access triples with a query
87 ;
88 n zoff,zlim,zcount,zq
89 k rtn
90 i '$d(limit) s limit=250
91 i '$d(offset) s offset=0
92 d qparse(.zq,query) ; parse the query
93 n qsub,qpred,qobj,qtmp
94 W !,zq(1)
95 s qsub=$p(zq(1),"^",1)
96 s qpred=$p(zq(1),"^",2)
97 s qobj=$p(zq(1),"^",3)
98 d triples(.qtmp,qsub,qpred,qobj)
99 f zcount=offset+1:1:offset+limit q:'$d(qtmp(zcount)) d ;
100 . s rtn(zcount)=qtmp(zcount)
101 q
102 ;
103triples(triplertn,sub,pred,obj,graph,fary) ; returns triples
104 I '$D(fary) D ;
105 . D INITFARY^C0XF2N("C0XFARY")
106 . S fary="C0XFARY"
107 D USEFARY^C0XF2N(fary)
108 k triplertn ; start with a clean return
109 n zsub,zpred,zobj,zgraph,tmprtn
110 s zsub=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(sub)),fary) ; ien of subject
111 s zpred=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(pred)),fary) ; ien of predicate
112 s zobj=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(obj)),fary) ; ien of object
113 s zgraph=$$IENOF^C0XF2N($g(graph),fary) ; ien of graph
114 W !,"s:",zsub," p:",zpred," o:",zobj
115 d trip(.tmprtn,zsub,zpred,zobj,zgraph,fary)
116 n zzz,zrsub,zrpred,zrobj,zgraph,zcnt,zrary
117 s zzz=""
118 f s zzz=$o(tmprtn(zzz)) q:zzz="" d ;
119 . s zrsub=$$GET1^DIQ(C0XTFN,zzz_",",.03,"E")
120 . s zrpred=$$GET1^DIQ(C0XTFN,zzz_",",.04,"E")
121 . s zrobj=$$GET1^DIQ(C0XTFN,zzz_",",.05,"E")
122 . s zrgraph=$$GET1^DIQ(C0XTFN,zzz_",",.02,"E")
123 . s zrary(zrsub,zrpred_"^"_zrobj)=""
124 ;b
125 ;
126 i REPLYFMT="JSON" d output(.triplertn,.zrary) q ; what follows is 'else'
127 ;
128 ; if no reply format is found we just output an array of triples
129 ;
130 s zrsub=""
131 s zcnt=1
132 f s zrsub=$o(zrary(zrsub)) q:zrsub="" d ; organized by subject
133 . s zzz=""
134 . f s zzz=$o(zrary(zrsub,zzz)) q:zzz="" d ; pred and obj
135 . . s triplertn(zcnt)=zrsub_"^"_zzz
136 . . s zcnt=zcnt+1
137 q
138 ;
139configfmt(zfmtary) ; configure output routine table
140 s zfmtary("REPLYSTART")="LISTSTART^FMQLJSON"
141 s zfmtary("LISTSTART")="LISTSTART^FMQLJSON"
142 s zfmtary("DICTSTART")="DICTSTART^FMQLJSON"
143 s zfmtary("DASSERT")="DASSERT^FMQLJSON"
144 s zfmtary("DICTEND")="DICTEND^FMQLJSON"
145 s zfmtary("LISTEND")="LISTEND^FMQLJSON"
146 s zfmtary("REPLYEND")="REPLYEND^FMQLJSON"
147 d USEARY^C0XF2N("zfmtary")
148 q
149 ;
150output(jout,zary) ;
151 n zformat
152 d configfmt(.zformat)
153 ;d REPLYSTART^FMQLJSON("jout")
154 d @REPLYSTART@("jout")
155 ;d LISTSTART^FMQLJSON("jout","results")
156 d @LISTSTART@("jout","results")
157 n zi s zi=""
158 f s zi=$o(zary(zi)) q:zi="" d ; for each subject
159 . n zii s zii=""
160 . ;D DICTSTART^FMQLJSON("jout",zi)
161 . D @DICTSTART@("jout",zi)
162 . f s zii=$o(zary(zi,zii)) q:zii="" d ; for each pred^obj pair
163 . . ;d DASSERT^FMQLJSON("jout",$p(zii,"^",1),$p(zii,"^",2))
164 . . d @DASSERT@("jout",$p(zii,"^",1),$p(zii,"^",2))
165 . ;D DICTEND^FMQLJSON("jout")
166 . D @DICTEND@("jout")
167 ;d LISTEND^FMQLJSON("jout")
168 d @LISTEND@("jout")
169 ;d REPLYEND^FMQLJSON("jout")
170 d @REPLYEND@("jout")
171 q
172 ;
173trip(triprtn,nsub,npred,nobj,ngraph,fary) ; returns triples iens
174 ; nsub,npred,nobj are all optional
175 ; graf is also optional, and will limit the search to a particular ngraph
176 ; fary is which triple store (not implemented yet)
177 n c0xflag,zi,zx,zt
178 s zt=$na(^C0X(101)) ;
179 n zf1,zf2,zf3
180 s zf1=$s($g(nsub)="":0,1:1)
181 s zf2=$s($g(npred)="":0,1:1)
182 s zf3=$s($g(nobj)="":0,1:1)
183 s c0xflag="I"_zf1_zf2_zf3
184 n itbl
185 s itbl("I000","SPO")="d do3(.triprtn,zt,zi)"
186 s itbl("I001","OSP")="d do2(.triprtn,zt,zi,nobj)"
187 s itbl("I010","PSO")="d do2(.triprtn,zt,zi,npred)"
188 s itbl("I011","POS")="d do1(.triprtn,zt,zi,npred,nobj)"
189 s itbl("I100","SPO")="d do2(.triprtn,zt,zi,nsub)"
190 s itbl("I101","SOP")="d do1(.triprtn,zt,zi,nsub,nobj)"
191 s itbl("I110","SPO")="d do1(.triprtn,zt,zi,nsub,npred)"
192 s itbl("I111","SPO")="d do0(.triprtn,zt,zi,nsub,npred,nobj)"
193 s zi=$o(itbl(c0xflag,""))
194 s zx=itbl(c0xflag,zi) ; executable instruction to run
195 i $g(ngraph)'="" s zi="G"_zi
196 w !,zx
197 x zx
198 q
199 ;
200do0(dortn,zt,zi,z1,z2,z3)
201 ; looking for only one triple
202 n zz
203 s zz=$o(@zt@(zi,z1,z2,z3,""))
204 i zz'="" s dortn(zz)=""
205 q
206 ;
207do1(dortn,zt,zi,z1,z2) ; have 2, looking for one
208 n zr,zx1
209 s zx1=""
210 f s zx1=$o(@zt@(zi,z1,z2,zx1)) q:zx1="" d ;
211 . s zr=$o(@zt@(zi,z1,z2,zx1,""))
212 . s dortn(zr)=""
213 q
214 ;
215do2(dortn,zt,zi,z1) ; have one, looking for 2
216 n zr,zx1,zx2
217 s (zx1,zx2)=""
218 f s zx1=$o(@zt@(zi,z1,zx1)) q:zx1="" d ;
219 . f s zx2=$o(@zt@(zi,z1,zx1,zx2)) q:zx2="" d ;
220 . . s zr=$o(@zt@(zi,z1,zx1,zx2,""))
221 . . s dortn(zr)=""
222 q
223 ;
224do3(dortn,zt,zi) ; have none, looking for three
225 n zr,zx1,zx2,zx3
226 s (zx1,zx2,zx3)=""
227 f s zx1=$o(@zt@(zi,zx1)) q:zx1="" d ;
228 . f s zx2=$o(@zt@(zi,zx1,zx2)) q:zx2="" d ;
229 . . f s zx3=$o(@zt@(zi,zx1,zx2,zx3)) q:zx3="" d ;
230 . . . s zr=$o(@zt@(zi,zx1,zx2,zx3,""))
231 . . . s dortn(zr)=""
232 q
233 ;
Note: See TracBrowser for help on using the repository browser.