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