[1343] | 1 | C0XGET1 ; 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 | ;
|
---|
| 22 | LSSUBJ(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 | ;
|
---|
[1349] | 28 | GRAPHS(RTN,C0XFARY) ; LIST ALL GRAPHS
|
---|
[1343] | 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 | ;
|
---|
| 37 | STR(ZIN,C0XFARY) ; EXTRINSIC RETURNS A STRING
|
---|
| 38 | I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
|
---|
| 39 | Q $$GET1^DIQ(C0XSFN,ZIN,.01,"E")
|
---|
| 40 | ;
|
---|
| 41 | SPO(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 | ;
|
---|
| 49 | S(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE SUBJECT
|
---|
| 50 | Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.03,"I")) ;
|
---|
| 51 | ;
|
---|
| 52 | P(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE PREDICATE
|
---|
| 53 | Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.04,"I")) ;
|
---|
| 54 | ;
|
---|
| 55 | O(ZNODE,C0XFARY) ; EXTRINSIC RETURNING THE OBJECT
|
---|
| 56 | Q $$STR($$GET1^DIQ(C0XTFN,ZNODE,.05,"I")) ;
|
---|
| 57 | ;
|
---|
| 58 | NXT(ZRTN) ;EXTRINSIC FOR THE NEXT NODE IN ARRAY ZRTN, PASSED BY REF
|
---|
[1349] | 59 | I '$D(ZRTN) S ZRTN=""
|
---|
[1343] | 60 | Q $O(ZRTN(""),-1)+1
|
---|
| 61 | ;
|
---|
| 62 | SING(ZRTN,ZG) ; SUBJECTS IN GRAPH
|
---|
| 63 | ;
|
---|
| 64 | I '$D(C0XFARY) D INITFARY^C0XF2N("C0XFARY")
|
---|
[1349] | 65 | I '$D(ZRTN) S ZRTN=""
|
---|
[1343] | 66 | N ZI,ZN S ZI=""
|
---|
[1349] | 67 | F S ZI=$O(@C0XTN@("GSPO",ZG,ZI)) Q:ZI="" D ;
|
---|
| 68 | . S ZRTN($$NXT(.ZRTN),"S")=$$STR(ZI)
|
---|
[1343] | 69 | Q
|
---|
[1349] | 70 | ;
|
---|
| 71 | triples(triplertn,sub,pred,obj,graph,fary) ; returns triples
|
---|
| 72 | I '$D(fary) D ;
|
---|
| 73 | . D INITFARY^C0XF2N("C0XFARY")
|
---|
| 74 | . S fary="C0XFARY"
|
---|
| 75 | D USEFARY^C0XF2N(fary)
|
---|
| 76 | k triplertn ; start with a clean return
|
---|
| 77 | n zsub,zpred,zobj,zgraph,tmprtn
|
---|
| 78 | s zsub=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(sub)),fary) ; ien of subject
|
---|
| 79 | s zpred=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(pred)),fary) ; ien of predicate
|
---|
| 80 | s zobj=$$IENOF^C0XF2N($$EXT^C0XUTIL($g(obj)),fary) ; ien of object
|
---|
| 81 | s zgraph=$$IENOF^C0XF2N($g(graph),fary) ; ien of graph
|
---|
| 82 | W !,"s:",zsub," p:",zpred," o:",zobj
|
---|
| 83 | d trip(.tmprtn,zsub,zpred,zobj,zgraph,fary)
|
---|
| 84 | n zzz,zrsub,zrpred,zrobj,zgraph
|
---|
| 85 | s zzz=""
|
---|
| 86 | f s zzz=$o(tmprtn(zzz)) q:zzz="" d ;
|
---|
| 87 | . s zrsub=$$GET1^DIQ(C0XTFN,zzz_",",.03,"E")
|
---|
| 88 | . s zrpred=$$GET1^DIQ(C0XTFN,zzz_",",.04,"E")
|
---|
| 89 | . s zrobj=$$GET1^DIQ(C0XTFN,zzz_",",.05,"E")
|
---|
| 90 | . s zrgraph=$$GET1^DIQ(C0XTFN,zzz_",",.02,"E")
|
---|
| 91 | . s triplertn(zzz)=zrsub_"^"_zrpred_"^"_zrobj ; _"^"_zrgraph
|
---|
| 92 | q
|
---|
| 93 | ;
|
---|
| 94 | trip(triprtn,nsub,npred,nobj,ngraph,fary) ; returns triples iens
|
---|
| 95 | ; nsub,npred,nobj are all optional
|
---|
| 96 | ; graf is also optional, and will limit the search to a particular ngraph
|
---|
| 97 | ; fary is which triple store (not implemented yet)
|
---|
| 98 | n c0xflag,zi,zx,zt
|
---|
| 99 | s zt=$na(^C0X(101)) ;
|
---|
| 100 | n zf1,zf2,zf3
|
---|
| 101 | s zf1=$s($g(nsub)="":0,1:1)
|
---|
| 102 | s zf2=$s($g(npred)="":0,1:1)
|
---|
| 103 | s zf3=$s($g(nobj)="":0,1:1)
|
---|
| 104 | s c0xflag="I"_zf1_zf2_zf3
|
---|
| 105 | n itbl
|
---|
| 106 | s itbl("I000","SPO")="d do3(.triprtn,zt,zi)"
|
---|
| 107 | s itbl("I001","OSP")="d do2(.triprtn,zt,zi,nobj)"
|
---|
| 108 | s itbl("I010","PSO")="d do2(.triprtn,zt,zi,npred)"
|
---|
| 109 | s itbl("I011","POS")="d do1(.triprtn,zt,zi,npred,nobj)"
|
---|
| 110 | s itbl("I100","SPO")="d do2(.triprtn,zt,zi,nsub)"
|
---|
| 111 | s itbl("I101","SOP")="d do1(.triprtn,zt,zi,nsub,nobj)"
|
---|
| 112 | s itbl("I110","SPO")="d do1(.triprtn,zt,zi,nsub,npred)"
|
---|
| 113 | s itbl("I111","SPO")="d do0(.triprtn,zt,zi,nsub,npred,nobj)"
|
---|
| 114 | s zi=$o(itbl(c0xflag,""))
|
---|
| 115 | s zx=itbl(c0xflag,zi) ; executable instruction to run
|
---|
| 116 | i $g(ngraph)'="" s zi="G"_zi
|
---|
| 117 | w !,zx
|
---|
| 118 | x zx
|
---|
| 119 | q
|
---|
| 120 | ;
|
---|
| 121 | do0(dortn,zt,zi,z1,z2,z3)
|
---|
| 122 | ; looking for only one triple
|
---|
| 123 | n zz
|
---|
| 124 | s zz=$o(@zt@(zi,z1,z2,z3,""))
|
---|
| 125 | i zz'="" s dortn(zz)=""
|
---|
| 126 | q
|
---|
| 127 | ;
|
---|
| 128 | do1(dortn,zt,zi,z1,z2) ; have 2, looking for one
|
---|
| 129 | n zr,zx1
|
---|
| 130 | s zx1=""
|
---|
| 131 | f s zx1=$o(@zt@(zi,z1,z2,zx1)) q:zx1="" d ;
|
---|
| 132 | . s zr=$o(@zt@(zi,z1,z2,zx1,""))
|
---|
| 133 | . s dortn(zr)=""
|
---|
| 134 | q
|
---|
| 135 | ;
|
---|
| 136 | do2(dortn,zt,zi,z1) ; have one, looking for 2
|
---|
| 137 | n zr,zx1,zx2
|
---|
| 138 | s (zx1,zx2)=""
|
---|
| 139 | f s zx1=$o(@zt@(zi,z1,zx1)) q:zx1="" d ;
|
---|
| 140 | . f s zx2=$o(@zt@(zi,z1,zx1,zx2)) q:zx2="" d ;
|
---|
| 141 | . . s zr=$o(@zt@(zi,z1,zx1,zx2,""))
|
---|
| 142 | . . s dortn(zr)=""
|
---|
| 143 | q
|
---|
| 144 | ;
|
---|
| 145 | do3(dortn,zt,zi) ; have none, looking for three
|
---|
| 146 | n zr,zx1,zx2,zx3
|
---|
| 147 | s (zx1,zx2,zx3)=""
|
---|
| 148 | f s zx1=$o(@zt@(zi,zx1)) q:zx1="" d ;
|
---|
| 149 | . f s zx2=$o(@zt@(zi,zx1,zx2)) q:zx2="" d ;
|
---|
| 150 | . . f s zx3=$o(@zt@(zi,zx1,zx2,zx3)) q:zx3="" d ;
|
---|
| 151 | . . . s zr=$o(@zt@(zi,zx1,zx2,zx3,""))
|
---|
| 152 | . . . s dortn(zr)=""
|
---|
| 153 | q
|
---|
| 154 | ;
|
---|