source: ccr/trunk/p/C0CMAIL.m@ 1800

Last change on this file since 1800 was 1586, checked in by Sam Habiel, 12 years ago

Changed license to AGPL. Some clean-up for XINDEX

  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CMAIL.m1290
    /ccr/branches/ohum/p/C0CMAIL.m1291-1543
    /ccr/branches/ohum/p/p/C0CMAIL.m1287-1289
File size: 11.6 KB
RevLine 
[1586]1C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
2V ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
[1544]3 ;Copyright 2011 Chris Richardson, Richardson Computer Research
4 ; Modified 3110516@1818
5 ; rcr@rcresearch.us
6 ;
[1586]7 ; This program is free software: you can redistribute it and/or modify
8 ; it under the terms of the GNU Affero General Public License as
9 ; published by the Free Software Foundation, either version 3 of the
10 ; License, or (at your option) any later version.
[1544]11 ;
[1586]12 ; This program is distributed in the hope that it will be useful,
13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ; GNU Affero General Public License for more details.
[1544]16 ;
[1586]17 ; You should have received a copy of the GNU Affero General Public License
18 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
[1544]19 ;
20 ; ------------------
21 ;Entry Points
22 ; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
23 ; Input:
24 ; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
25 ; or "*" for all boxes, default is "IN" if missing]"
26 ; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
27 ; "*" for All or 9,999 maximum
28 ; MALL?1.n = that number of the n most recent
29 ; Internally:
30 ; BNAM = Box Name
31 ; Output:
32 ; C0CDATA
33 ; = (BNAM,"NUMBER") = Number of NEW Emails in Basket
34 ; (BNAM,"MSG",C0CIEN,"FROM")=Name
35 ; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
36 ; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
37 ; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
38 ; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
39 ; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
40 ; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
41 ; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
42 ; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
43 ; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
44 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
45 ; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
46 ;
47 ; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
48 ; Input;
49 ; D0 - The IEN for the message in file 3.9, MESSAGE global
50 ; Output
51 ; OUTBF - The array of your choice to save the expanded and decoded message.
52 ;
53GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
54 K:'$G(C0CDATA("KEEP")) C0CDATA
55 N U
56 S U="^"
57 D:$G(C0CINPUT)
58 . N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
59 . S INPUT=C0CINPUT
60 . S DUZ=+INPUT
61 . D:$D(^XMB(3.7,DUZ,0))#2
62 . . S MBLST=$P(INPUT,";",2)
63 . . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
64 . . S:MALL["*" MALL=99999
65 . . ; Only one of these can be correct
66 . . D
67 . . . ; If nul, make it "IN" only
68 . . . I MBLST="" D QUIT
69 . . . . S MBLST("IN")=0,I=0
70 . . . . D GATHER(DUZ,"IN",.LST)
71 . . . .QUIT
72 . . . ;
73 . . . ; If "*", Get all Mailboxes and look for New Messages
74 . . . I MBLST["*" D QUIT
75 . . . . N NAM,NUM
76 . . . . S NUM=0
77 . . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D
78 . . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
79 . . . . . D GATHER(DUZ,NAM,.LST)
80 . . . . .QUIT
81 . . . .QUIT
82 . . . ;
83 . . . ; If comma separated, look for mailboxes with new messages
84 . . . I $L(MBLST,",")>1 D QUIT
85 . . . . S NAM=""
86 . . . . N T,V
87 . . . . F T=1:1:$L(MBLST,",") S V=$P(MBLST,",",T) I $L(V) D
88 . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
89 . . . . . S:NAM="" NAM=V
90 . . . . . D GATHER(DUZ,NAM,.LST)
91 . . . . .QUIT
92 . . . .QUIT
93 . . . ;
94 . . . ; If only 1 mailbox named, go get it
95 . . . I $L(MBLST) D GATHER(DUZ,MBLST,.LST) QUIT
96 . . .QUIT
97 . . MERGE C0CDATA=LST
98 . .QUIT
99 .QUIT
100 QUIT
101 ; ===================
102GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
103 N I,J,K,L
104 S (I,K)=0
105 S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
106 F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D
107 . S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
108 . D ; :L
109 . . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails
110 . . S LST(NAM,"MSG",I)=L
111 . . D GETTYP(I)
112 . .QUIT
113 .QUIT
114 S LST(NAM,"NUMBER")=K
115 QUIT
116 ; ===================
117 ; D0 is the IEN into the Message Global ^XMB(3.9,D0)
118 ; The products of these emails are scanned to identify
119 ; the number of documents stored in the MIME package.
120 ; The protocol runs like this;
121 ; Line 1 is the --separator
122 ; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
123 ; Line n+2 thru t-1 where t does NOT have "Content-"
124 ; Line t is Next Section Terminator, or Message Terminator, --separator
125 ; Line t+1 should not exist in the data set if Message Terminator
126 ; CON = "Content-"
127 ; FLG = "--"
128 ; SEP = FLG+7 or more characters ; Separator
129 ; END = SEP+FLG
130 ; SGC = Segment Count
131 ; Note: separator is a string of specific characters of
132 ; indeterminate length
133 ; LST() the transfer array
134 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
135 ; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
136 ;
137GETTYP(D0) ; Look for the goodies in the Mail
138 N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
139 S CON="Content-"
140 S FLG="--"
141 S SEP="" ; Start SEP as null, so we can use this to help identify the type
142 S (BCN,CNT,D1,END,SGC)=0
143 S XX=$G(^XMB(3.9,D0,0))
144 S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
145 S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
146 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
147 S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
148 S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
149 ; Get the folks the email is sent to.
150 S D1=0
151 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D
152 . N T
153 . S T=+$G(^XMB(3.9,D0,1,D1,0))
154 . S:T T=$P($G(^VA(200,+T,0)),"^")
155 . S LST("TO",D1)=T
156 . S T=$G(^XMB(3.9,D0,6,D1,0))
157 . S:T T=$P($G(^VA(200,+T,0)),"^")
158 . S:T="" T="<Unknown>"
159 . S LST("TO NAME",D1)=T
160 .QUIT
161 ; Preload first Segment (0) with beginning on Line 1
162 ; if not a 64bit
163 S LST(NAM,"MSG",D0,"SEG",0)=1
164 S D1=.9999,SEP="--"
165 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
166 . ; Clear any control characters (cr/lf/ff) off
167 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
168 . ; Enter once to set the SEP to capture the separator
169 . I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q
170 . . S SEP=X,END=X_FLG
171 . . S (CNT,SGC)=1,BCN=0
172 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
173 . .QUIT
174 . ;
175 . ; A new separator is set, process original
176 . I X=SEP D QUIT
177 . . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN
178 . . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
179 . . S SGC=SGC+1,BCN=0
180 . . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
181 . .QUIT
182 . ;
183 . S BCN=BCN+$L(X)
184 . I X[CON D Q
185 . . S J=$P($P(X,";"),CON,2)
186 . . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
187 . .QUIT
188 . ;
189 . ; S LST(NAM,"MSG",D0,"SEG",D1)=X
190 .QUIT
191 QUIT
192 ; ===================
193NAME(NM) ; Return the name of the Sender
194 N NAME
195 S NAME="<Unknown Sender>"
196 D
197 . ; Look first for a value to use with the NEW PERSON file
198 . ;
199 . I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
200 . ;
201 . I $L(NM) S NAME=NM Q
202 . ;
203 . ; Else, pull the data from the message and display the foreign source
204 . ; of the message.
205 . N T
206 . S VAL=$G(^XMB(3.9,D0,.7))
207 . S:VAL T=$P(^VA(200,VAL,0),U)
208 . I $L($G(T)) S NAME=T Q
209 . ;
210 .QUIT
211 QUIT NAME
212 ; ===================
213TIME(Y) ; The time and date of the sending
214 X ^DD("DD")
215 QUIT Y
216 ; ===================
217 ; Segments in Message need to be identified and decoded properly
218 ; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message
219 ; ARRAY will have the details of this one call
220 ;
221 ; Inputs;
222 ; C0CINPUT - The IEN of the message to expand
223 ; Outputs;
224 ; C0CDATA - Carrier for the returned structure of the Message
225 ; C0CDATA(D0,"SEG")=number of SEGMENTS
226 ; C0CDATA(D0,"SEG",0:n)=SEGMENT n details
227 ; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
228 ; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
229 ; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
230 ;
231DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
232 N LST,D0,D1,U
233 S U="^"
234 S D0=+$G(C0CINPUT)
235 I D0 D QUIT
236 . D GETTYP2(D0)
237 . I $D(LST) M C0CDATA(D0)=LST
238 .QUIT
239 QUIT
240 ; ===================
241 ; End note if needed
242 ; MSK - Set of characters that do not exist in 64 bit encoding
243GETTYP2(D0) ; Try to get the types and MSK for the
244 N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
245 S CON="Content-",U="^"
246 S FLG="--"
247 S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
248 S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type
249 S (BCN,CNT,D1,END,SGC)=0
250 S XX=$G(^XMB(3.9,D0,0))
251 ; S K=$P(^XMB(3.9,D0,2,0),U,3)
252 S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
253 S LST("CREATED")=$$TIME($P(XX,U,3))
254 F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
255 S LST("FROM")=$$NAME(XXNM)
256 ; Get the folks the email is sent to.
257 S D1=0
258 F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""
259 . N I,T
260 . S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
261 . S:T T=$P($G(^VA(200,T,0)),"^")
262 . S LST("TO",+D1)=T
263 . S T=$G(^XMB(3.9,D0,6,+D1,0))
264 . S:T="" T=$P($G(^VA(200,+T,0)),"^")
265 . S:T="" T="<Unknown>"
266 . S LST("TO NAME",D1)=T
267 .QUIT
268 ; Get the Header for the message
269 S D1=0
270 F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D
271 . S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
272 .QUIT
273 ; Start walking the different sections
274 S D1=.99999,SEP="--"
275 F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
276 . ; Clear any control characters (cr/lf/ff) off
277 . S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
278 . ; Enter once to set the SEP to capture the separator
279 . I (SEP="--")&($E(X,1,2)=FLG)&($L(X,FLG)=2) D Q
280 . . S SEP=X,END=X_FLG
281 . . S (CNT,SGC)=1,BCN=0
282 . . S LST("SEG",SGC)=D1
283 . .QUIT
284 . ;
285 . ; A new SEGMENT separator is set, process original
286 . I X=SEP D QUIT
287 . . ; Save Current Values
288 . . S LST("SEG",SGC,"SIZE")=BCN
289 . . ; Close this Segment and prepare to start a New Segment
290 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
291 . . ; Put the result in LST("SEG",SGC,"XML")
292 . . I $L(BF) D
293 . . . S ZN=1
294 . . . N I,T,TBF
295 . . . S TBF=BF
296 . . . F I=1:1:($L(TBF,"=")) D
297 . . . . S BF=$P(TBF,"=",I)_"="
298 . . . . I BF'="=" D DECODER
299 . . . .QUIT
300 . . . S BF=""
301 . . .QUIT
302 . . S SGC=SGC+1,BCN=0
303 . . ; Incriment SGC to start a new Segment
304 . . S LST("SEG",SGC)=D1
305 . .QUIT
306 . ;
307 . ; Accumulate the 64 bit encoding
308 . I X=$TR(X,MSK)&$L(X) D Q
309 . . S BF=BF_X
310 . . S BCN=BCN+$L(X)
311 . .QUIT
312 . ;
313 . ; Ending Condition, close out the Segment
314 . I X=END D QUIT
315 . . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
316 . . I $L(BF) S ZN=1 D DECODER S BF="" Q
317 . .QUIT
318 . ;
319 . S BCN=BCN+$L(X)
320 . ; Split out the Content Info
321 . I X[CON D Q
322 . . S J=$P(X,CON,2)
323 . . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
324 . .QUIT
325 . ;
326 . ; Everything else is Text
327 . S LST("SEG",SGC,"TXT",D1)=X
328 .QUIT
329 QUIT
330 ; ===================
331 ; Break down the Buffer Array so it can be saved.
332 ; BF is passed in.
333DECODER ;
334 N RCNT,TBF,ZBF,ZI,ZJ,ZK,ZSIZE
335 S ZBF=BF
336 ; Full Buffer, BF, now check for Encryption and Unpack
337 F RCNT=1:1:$L(ZBF,"=") D
338 . N BF
339 . S BF=$P(ZBF,"=",RCNT)
340 . ; Unpacking the 64 bit encoding
341 . S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
342 . D:$L(TBF)
343 . . N XBF
344 . . S BF=BF_"="
345 . . D NORMAL(.XBF,.TBF)
346 . . M LST("SEG",SGC,"XML",RCNT)=XBF
347 . .QUIT
348 .QUIT
349 QUIT
350 ; ===================
351 ; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT
352 ; BF = INXML = INPUT ARRAY TO PROVIDE INPUT
353 ; >D NORMAL^C0CMAIL(.OUT,BF)
354NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
355 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
356 ;
357 N ZN,OUTBF
358 S ZN=1
359 S OUTBF(ZN)=$P(INXML,"><",ZN)_">"
360 F ZN=ZN+1:1 S OUTBF(ZN)="<"_$P(INXML,"><",ZN) Q:$P(INXML,"><",ZN+1)="" D ;
361 . S OUTBF(ZN)=OUTBF(ZN)_">"
362 .QUIT
363 M OUTXML=OUTBF
364 QUIT
365 ; ===================
366 ; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv
367 ; End note if needed
368 QUIT
369 ; ===================
Note: See TracBrowser for help on using the repository browser.