src/tnef/attachment.hs

   1 --
   2 -- Copyright Michael Orlitzky
   3 --
   4 -- http://michael.orlitzky.com/
   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 3 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 -- http://www.fsf.org/licensing/licenses/gpl.html
  17 --
  18
  19 module Tnef.Attachment where
  20
  21 import Tnef.Object
  22
  23 data TnefAttachment = TnefAttachment { att_mod_date :: TnefObject,
  24                                        att_data :: TnefObject,
  25                                        att_file_name :: TnefObject,
  26                                        att_meta_file :: TnefObject,
  27                                        att_attachment :: TnefObject }
  28                     | NilAttachment
  29                       deriving (Show)
  30
  31
  32 get_attachment_list :: [TnefObject] -> [TnefAttachment]
  33 get_attachment_list [] = []
  34 get_attachment_list [Nil] = []
  35 get_attachment_list (x:xs)
  36     | (show (obj_name x) == "Attachment Rendering Data") = (make_attachment xs) : get_attachment_list xs
  37     | otherwise = get_attachment_list xs
  38
  39
  40 make_attachment :: [TnefObject] -> TnefAttachment
  41 make_attachment xs
  42     | length xs < 5 = NilAttachment
  43     | otherwise = TnefAttachment m d f mf a
  44                   where
  45                     m = get_first_with_name xs "Attachment Modification Date"
  46                     d = get_first_with_name xs "Attachment Data"
  47                     f = get_first_with_name xs "Attachment File Name"
  48                     mf = get_first_with_name xs "Attachment Meta File"
  49                     a = get_first_with_name xs "Attachment"
  50
  51 safe_head :: [TnefObject] -> TnefObject
  52 safe_head xs
  53     | ((length xs) == 0) = Nil
  54     | otherwise = head xs
  55
  56
  57 get_first_with_name :: [TnefObject] -> String -> TnefObject
  58 get_first_with_name xs name =
  59     safe_head (dropWhile ((/= name) . show . obj_name) xs)
  60
  61
  62 write_attachment :: TnefAttachment -> IO ()
  63 write_attachment NilAttachment = putStrLn "NilAttachment"
  64 write_attachment x = do
  65   write_tnef_object (show_data (att_file_name x)) (att_data x)