source: fmts/trunk/p/C0XGET1.m@ 1374

Last change on this file since 1374 was 1374, checked in by George Lilly, 12 years ago

working on pred and objects queries
File size: 10.8 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=query ; 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 ;
86getGraph(zrtn,zgrf,form) ; get all triples in graph zgrf
87 ; forms planned: "rdf" "json" "array" "turtle" "triples"
88 ; forms supported: "rdf" "json" "array"
89 I '$D(form) S form="rdf"
90 N ZIENS,ZTRIP
91 D TING^C0XF2N(.ZIENS,zgrf)
92 I '$D(ZIENS) Q ;
93 D ien2tary(.ZTRIP,"ZIENS")
94 I form="json" d jsonout(.zrtn,.ZTRIP) q ; what follows is else
95 i form="rdf" d rdfout^C0XRDF(.zrtn,.ZTRIP) q ;
96 i form="array" d arrayout^C0XGET1(.zrtn,.ZTRIP) q ;
97 W !,"Form not supported: ",form
98 Q
99 ;
100rpctrip(rtn,query,limit,offset) ; rpc to access triples with a query
101 ;
102 n zoff,zlim,zcount,zq
103 k rtn
104 i '$d(limit) s limit=250
105 i '$d(offset) s offset=0
106 d qparse(.zq,query) ; parse the query
107 n qsub,qpred,qobj,qtmp
108 W !,zq(1)
109 s qsub=$p(zq(1),"^",1)
110 s qpred=$p(zq(1),"^",2)
111 s qobj=$p(zq(1),"^",3)
112 d triples(.qtmp,qsub,qpred,qobj)
113 f zcount=offset+1:1:offset+limit q:'$d(qtmp(zcount)) d ;
114 . s rtn(zcount)=qtmp(zcount)
115 q
116 ;
117triples(triplertn,sub,pred,obj,graph,form,fary) ; returns triples
118 I '$D(fary) D ;
119 . D INITFARY^C0XF2N("C0XFARY")
120 . S fary="C0XFARY"
121 D USEFARY^C0XF2N(fary)
122 I '$D(form) S form="json"
123 k triplertn ; start with a clean return
124 n zsub,zpred,zobj,zgraph,tmprtn
125 s zsub=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(sub)),fary) ; ien of subject
126 s zpred=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(pred)),fary) ; ien of predicate
127 s zobj=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(obj)),fary) ; ien of object
128 s zgraph=$$IENOF^C0XF2N($g(graph),fary) ; ien of graph
129 W !,"s:",zsub," p:",zpred," o:",zobj
130 d trip(.tmprtn,zsub,zpred,zobj,zgraph,fary)
131 d ien2tary(.zrary,"tmprtn") ; convert to triples
132 ;
133 i form="json" d jsonout(.triplertn,.zrary) q ; what follows is 'else'
134 i form="rdf" d rdfout^C0XRDF(.triplertn,.zrary) q ;
135 i form="array" d arrayout(.triplertn,.zrary) q ;
136 w !,"form not supported: ",form
137 q
138 ;
139subjects(listrtn,sub,pred,obj,graph,form,fary) ; return list of subjects
140 d onelist("S") ;subjects
141 q
142 ;
143preds(listrtn,sub,pred,obj,graph,form,fary) ; return list of subjects
144 d onelist("P") ;subjects
145 q
146 ;
147objects(listrtn,sub,pred,obj,graph,form,fary) ; return list of subjects
148 d onelist("O") ;subjects
149 q
150 ;
151onelist(zw) ; returns list
152 ; zw is S P or O depending on what should be returned
153 I '$D(fary) D ;
154 . D INITFARY^C0XF2N("C0XFARY")
155 . S fary="C0XFARY"
156 D USEFARY^C0XF2N(fary)
157 I '$D(form) S form="json"
158 k listrtn ; start with a clean return
159 n zsub,zpred,zobj,zgraph,tmprtn
160 s zsub=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(sub)),fary) ; ien of subject
161 s zpred=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(pred)),fary) ; ien of predicate
162 s zobj=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(obj)),fary) ; ien of object
163 s zgraph=$$IENOF^C0XF2N($g(graph),fary) ; ien of graph
164 W !,"s:",zsub," p:",zpred," o:",zobj
165 n c0xflag,zi,zx,zt
166 s zt=$na(^C0X(101)) ;
167 s c0xflag=$$meta(zsub,zpred,zobj) ; get meta flags
168 k tmprtn
169 n itbl,ii,ix
170 s ii=$s(zw="S":"SPO",zw="P":"POS",zw="O":"OSP") ; no constraint
171 s itbl("I000",ii)="d zip(.tmprtn,zt,zi)"
172 s ii=$s(zw="S":"OSP",zw="P":"OPS",zw="O":"OSP") ; obj constraint
173 s ix=$s(zw="O":"d just(zobj)",1:"d zip1(.tmprtn,zt,zi,zobj)")
174 s itbl("I001",ii)=ix
175 s ii=$s(zw="S":"PSO",zw="P":"POS",zw="O":"OPS") ; pred constraint
176 s ix=$s(zw="O":"d just(zpred)",1:"d zip1(.tmprtn,zt,zi,zpred)")
177 s itbl("I010","PSO")=ix
178 s ii=$s(zw="S":"POS",zw="P":"OPS",zw="O":"OSP") ; pred + obj constraint
179 s ix=$s(zw="S":"d zip2(.tmprtn,zt,zi,zpred,zobj)",zw="P":"d just(zpred)",zw="O":"d just(zobj)",1:"d just(zobj)")
180 s itbl("I011","POS")=ix
181 s itbl("I100","SPO")="d zip(.tmprtn,zt,zi)"
182 s itbl("I101","OSP")="d zip1(.tmprtn,zt,zi,zobj)"
183 s itbl("I110","PSO")="d zip1(.tmprtn,zt,zi,zpred)"
184 s itbl("I111","POS")="d zip2(.tmprtn,zt,zi,zpred,zobj)"
185 s zi=$o(itbl(c0xflag,""))
186 s zx=itbl(c0xflag,zi) ; executable instruction to run
187 i $g(ngraph)'="" s zi="G"_zi
188 w !,zx
189 x zx
190 k listrtn
191 d strings(.listrtn,"tmprtn") ; convert pointer to strings
192 q
193 ;
194just(zin) ; add one element to tmprtn
195 s tmprtn(zin)=""
196 q
197 ;
198zip(zrtn,zt,zi) ; pull out just the first element of the index
199 ;
200 n zii s zii=""
201 f s zii=$o(@zt@(zi,zii)) q:zii="" d ;
202 . s zrtn(zii)=""
203 q
204 ;
205zip1(zrtn,zt,zi,zn) ; pull out just the first element of the index
206 ;
207 n zii s zii=""
208 f s zii=$o(@zt@(zi,zn,zii)) q:zii="" d ;
209 . s zrtn(zii)=""
210 q
211 ;
212zip2(zrtn,zt,zi,zn,zn1) ; pull out just the first element of the index
213 ;
214 n zii s zii=""
215 f s zii=$o(@zt@(zi,zn,zn1,zii)) q:zii="" d ;
216 . s zrtn(zii)=""
217 q
218 ;
219arrayout(rtn,zary) ; output an array of triples
220 ;
221 s zrsub=""
222 s zcnt=1
223 f s zrsub=$o(zary(zrsub)) q:zrsub="" d ; organized by subject
224 . s zzz=""
225 . f s zzz=$o(zary(zrsub,zzz)) q:zzz="" d ; pred and obj
226 . . s rtn(zcnt)=zrsub_"^"_zzz
227 . . s zcnt=zcnt+1
228 q
229 ;
230strings(zrary,zinary) ; convert pointers to strings
231 ;
232 k zrary
233 n zzz s zzz=""
234 f s zzz=$o(@zinary@(zzz)) q:zzz="" d ;
235 . n zs
236 . s zs=$$GET1^DIQ(C0XSFN,zzz_",",.01)
237 . q:zs=""
238 . s zrary(zs)=""
239 q
240 ;
241ien2tary(zrary,zinary) ; zinary is an array of iens passed by name
242 ; zrary is passed by reference and is return array of triples
243 ; format zrary(zsub,"zpred^zobj")=""
244 ;
245 k zrary ; start out clean
246 n zzz,zrsub,zrpred,zrobj,zgraph,zcnt
247 s zzz=""
248 f s zzz=$o(@zinary@(zzz)) q:zzz="" d ;
249 . s zrsub=$$GET1^DIQ(C0XTFN,zzz_",",.03,"E")
250 . s zrpred=$$GET1^DIQ(C0XTFN,zzz_",",.04,"E")
251 . s zrobj=$$GET1^DIQ(C0XTFN,zzz_",",.05,"E")
252 . s zrgraph=$$GET1^DIQ(C0XTFN,zzz_",",.02,"E")
253 . s zrary(zrsub,zrpred_"^"_zrobj)=""
254 q
255 ;
256jsonout(jout,zary) ;
257 d REPLYSTART^FMQLJSON("jout")
258 d LISTSTART^FMQLJSON("jout","results")
259 n zi s zi=""
260 f s zi=$o(zary(zi)) q:zi="" d ; for each subject
261 . n zii s zii=""
262 . D DICTSTART^FMQLJSON("jout",zi)
263 . f s zii=$o(zary(zi,zii)) q:zii="" d ; for each pred^obj pair
264 . . d DASSERT^FMQLJSON("jout",$p(zii,"^",1),$p(zii,"^",2))
265 . D DICTEND^FMQLJSON("jout")
266 d LISTEND^FMQLJSON("jout")
267 d REPLYEND^FMQLJSON("jout")
268 q
269 ;
270meta(zsub,zpred,zobj) ; function to return meta information
271 ; about the inputs ie I100 for just a subject and no pred or obj
272 n zf1,zf2,zf3,zflag
273 s zf1=$s($g(zsub)="":0,1:1)
274 s zf2=$s($g(zpred)="":0,1:1)
275 s zf3=$s($g(zobj)="":0,1:1)
276 s zflag="I"_zf1_zf2_zf3
277 q zflag
278 ;
279trip(triprtn,nsub,npred,nobj,ngraph,fary) ; returns triples iens
280 ; nsub,npred,nobj are all optional
281 ; graf is also optional, and will limit the search to a particular ngraph
282 ; fary is which triple store (not implemented yet)
283 n c0xflag,zi,zx,zt
284 s zt=$na(^C0X(101)) ;
285 s c0xflag=$$meta(nsub,npred,nobj) ; get meta flags
286 n itbl
287 s itbl("I000","SPO")="d do3(.triprtn,zt,zi)"
288 s itbl("I001","OSP")="d do2(.triprtn,zt,zi,nobj)"
289 s itbl("I010","PSO")="d do2(.triprtn,zt,zi,npred)"
290 s itbl("I011","POS")="d do1(.triprtn,zt,zi,npred,nobj)"
291 s itbl("I100","SPO")="d do2(.triprtn,zt,zi,nsub)"
292 s itbl("I101","SOP")="d do1(.triprtn,zt,zi,nsub,nobj)"
293 s itbl("I110","SPO")="d do1(.triprtn,zt,zi,nsub,npred)"
294 s itbl("I111","SPO")="d do0(.triprtn,zt,zi,nsub,npred,nobj)"
295 s zi=$o(itbl(c0xflag,""))
296 s zx=itbl(c0xflag,zi) ; executable instruction to run
297 i $g(ngraph)'="" s zi="G"_zi
298 w !,zx
299 x zx
300 q
301 ;
302do0(dortn,zt,zi,z1,z2,z3)
303 ; looking for only one triple
304 n zz
305 s zz=$o(@zt@(zi,z1,z2,z3,""))
306 i zz'="" s dortn(zz)=""
307 q
308 ;
309do1(dortn,zt,zi,z1,z2) ; have 2, looking for one
310 n zr,zx1
311 s zx1=""
312 f s zx1=$o(@zt@(zi,z1,z2,zx1)) q:zx1="" d ;
313 . s zr=$o(@zt@(zi,z1,z2,zx1,""))
314 . s dortn(zr)=""
315 q
316 ;
317do2(dortn,zt,zi,z1) ; have one, looking for 2
318 n zr,zx1,zx2
319 s (zx1,zx2)=""
320 f s zx1=$o(@zt@(zi,z1,zx1)) q:zx1="" d ;
321 . f s zx2=$o(@zt@(zi,z1,zx1,zx2)) q:zx2="" d ;
322 . . s zr=$o(@zt@(zi,z1,zx1,zx2,""))
323 . . s dortn(zr)=""
324 q
325 ;
326do3(dortn,zt,zi) ; have none, looking for three
327 n zr,zx1,zx2,zx3
328 s (zx1,zx2,zx3)=""
329 f s zx1=$o(@zt@(zi,zx1)) q:zx1="" d ;
330 . f s zx2=$o(@zt@(zi,zx1,zx2)) q:zx2="" d ;
331 . . f s zx3=$o(@zt@(zi,zx1,zx2,zx3)) q:zx3="" d ;
332 . . . s zr=$o(@zt@(zi,zx1,zx2,zx3,""))
333 . . . s dortn(zr)=""
334 q
335 ;
336output(zwhat,zfname,zdir) ; function to write an array to a host file
337 ; if zdir is ommitted, will output to the CCR directory
338 ; ^TMP("C0CCCR","ODIR")
339 ; if fname is ommitted, will output yyyy-mm-dd-hh-mm-ss-C0XOUT.out
340 ; zwhat is passed by name
341 ;
342 i '$d(zdir) s zdir=$G(^TMP("C0CCCR","ODIR"))
343 i '$d(zfname) d ;
344 . s zfname=$$FMTE^XLFDT($$NOW^XLFDT,7)
345 . s zfname=$tr(zfname,"/","-")
346 . s zfname=$tr(zfname,"@","-")
347 . s zfname=$tr(zfname,":","-")
348 . s zfname=zfname_".out"
349 i $e(zwhat,1,1)'="^" d ; not a global
350 . k ^TMP("C0XOUT",$J)
351 . m ^TMP("C0XOUT",$J)=@zwhat
352 . s zwhat=$na(^TMP("C0XOUT",$J,1))
353 n zout s zout=""
354 s zout=$$OUTPUT^C0CXPATH(zwhat,zfname,zdir)
355 K ^TMP("C0XOUT",$J)
356 Q zout
357 ;
Note: See TracBrowser for help on using the repository browser.