1. james woodyatt
  2. oni

Commits

jhwoodyatt  committed 70055bd

Make the field list an optional argument to the parsing class. Make the
simplified interfaces return objects rather than creating an object and
invoking a method to get the result. Remove dead code.

  • Participants
  • Parent commits 29d13c3
  • Branches default

Comments (0)

Files changed (2)

File mime/mime_entity.ml

View file
         p_end_of_field >>= fun () ->
         ~:addr
     in
-    fun fields body ->
+    fun ?h:fields body ->
+		let fields, body =
+			match fields with
+			| None ->
+				Mime_lex.split_into_fields body
+			| Some fields ->
+				fields, body
+		in
         let ctz, fields =
             L.select_opt_field S.content_type p_content_type fields
         in
         in
         object(_:'self)
             constraint 'self = #t
+			
+			val body_ = body
             
-            val body_: Cf_message.t = body
-
             method content_type = Lazy.force ctz
             method content_disposition = Lazy.force cdiz
             method content_transfer_encoding = Lazy.force ctez            
 
             method unstructured = Lazy.force unstructured
             method body = body_
+			
+			method put_body m = {< body_ = body_ @ m >}
             
             method force =
                 let _ = Lazy.force ctz in
                 let _ = Lazy.force clz in
                 let _ = Lazy.force cidz in
                 ()
-            
-            method put_body m = {< body_ = m >}
+            			
+			initializer
+				List.iter begin fun (name, body) ->
+					jout#info "Mime_entity.parsing: name=%s body='%s'"
+						name (Cf_seq.to_string body)
+				end fields
         end
 
 let parse msg =
-    let fields, body = L.split_into_fields msg in
-    new parsing fields body
+	let p = new parsing msg in
+	p#force;
+	p
 
 class emitting =
     let e_content_type pp ct =
     end
 
 let emit ?ct ?cdi ?cte ?cde ?cl ?cid ?u body =
-    let e = new emitting ?ct ?cdi ?cte ?cde ?cl ?cid ?u body in
-    e#emit
-
-(* OBSOLETE! below this line *)
-
-(*
-type f_content_type_t = [ `F_content_type of ct_t ]
-type f_content_disposition_t = [ `F_content_disposition of cd_t ]
-type f_content_transfer_encoding_t = [ `F_content_transfer_encoding of cte_t ]
-type f_content_description_t = [ `F_content_description of string ]
-type f_content_length_t = [ `F_content_length of int64 ]
-type f_content_id_t = [ `F_content_id of string * string ]
-type f_unstructured_t = [ `F_unstructured of string * string ]
-
-type header_field_t = [
-    | f_content_type_t
-    | f_content_disposition_t
-    | f_content_transfer_encoding_t
-    | f_content_description_t
-    | f_content_length_t
-    | f_content_id_t
-    | f_unstructured_t
-]
-
-class ['c, 'f] header_parser =
-    object(self)
-        constraint 'f = [> header_field_t ]
-        inherit ['c, 'f] Mime_parser.t as super
-        
-        method private content_type =
-            self#require begin
-                token_ >>= fun ct_type ->
-                match ct_type_of_string ct_type with
-                | None ->
-                    self#error
-                | Some ct_type ->
-                    self#require begin
-                        ?:'/' >>= fun ch ->
-                        self#require begin
-                            token_ >>= fun ct_subtype ->
-                            let ct_subtype = String.lowercase ct_subtype in
-                            parameters_ >>= fun ct_params ->
-                            let ct = {
-                                ct_type = ct_type;
-                                ct_subtype = ct_subtype;
-                                ct_parameters = ct_params;
-                            } in
-                            ~:(`F_content_type ct)
-                        end
-                    end
-            end
-        
-        method private content_disposition =
-            self#require begin
-                token_ >>= fun cd_type ->
-                match cd_type_of_string cd_type with
-                | None ->
-                    self#error
-                | Some cd_type ->
-                    parameters_ >>= fun cd_params ->
-                    let cd = {
-                        cd_type = cd_type;
-                        cd_parameters = cd_params;
-                    } in
-                    ~:(`F_content_disposition cd)
-            end
-        
-        method private content_transfer_encoding =
-            self#require begin
-                token_ >>= fun token ->
-                match cte_of_string token with
-                | None -> self#error
-                | Some cte -> ~:(`F_content_transfer_encoding cte)
-            end
-        
-        method private content_description =
-            unstructured_ >>= fun text ->
-            ~:(`F_content_description text)
-                        
-        method private content_length =
-            self#require begin
-                Cf_scan_parser.scanfx "%Lu" (fun x -> x) >>= fun len ->
-                ~:(`F_content_length len)
-            end
-        
-        method private content_id =
-            optcfws_ >>= fun () ->
-            self#require begin
-                ?:'<' >>= fun _ ->
-                self#require begin
-                    addr_spec_ >>= fun addr ->
-                    self#require begin
-                        ?:'>' >>= fun _ ->
-                        optcfws_ >>= fun () ->
-                        ~:(`F_content_id addr)
-                    end
-                end
-            end
-        
-        method private field_body name =
-            let name' = String.lowercase name in
-            let namelen = String.length name in
-            if namelen > 8 && (String.sub name' 0 8 = "content-") then
-                match String.sub name' 8 (namelen - 8) with
-                | "type" -> self#content_type
-                | "disposition" -> self#content_disposition
-                | "transfer-encoding" -> self#content_transfer_encoding
-                | "description" -> self#content_description
-                | "id" -> self#content_id
-                | "length" -> self#content_length
-                | _ -> super#field_body name
-            else
-                super#field_body name
-    end
-
-class ['f] header_emitter =
-    object(self)
-        constraint 'f = [> header_field_t ]
-        inherit ['f] Mime_emitter.t as super
-        
-        method private content_type pp ct =
-            Format.fprintf pp "Content-Type: %s/%s"
-                (ct_type_to_string ct.ct_type) ct.ct_subtype;
-            Mime_emitter.parameters pp ct.ct_parameters
-        
-        method private content_disposition pp cd =
-            Format.fprintf pp "Content-Disposition: %s"
-                (cd_type_to_string cd.cd_type);
-            Mime_emitter.parameters pp cd.cd_parameters
-        
-        method private content_transfer_encoding pp cte =
-            Format.fprintf pp "Content-Transfer-Encoding: %s"
-                (cte_to_string cte)
-        
-        method private content_description pp text =
-            Format.fprintf pp "Content-Description: %s" text
-        
-        method private content_length pp len =
-            Format.fprintf pp "Content-Length: %Lu" len
-        
-        method private content_id pp (local, domain) =
-            Format.pp_print_string pp "Content-Id: <";
-            Mime_emitter.addr_local pp local;
-            Format.pp_print_char pp '@';
-            Mime_emitter.addr_domain pp domain;
-            Format.pp_print_char pp '>'
-                        
-        method private field pp = function
-            | `F_content_type ct -> self#content_type pp ct
-            | `F_content_disposition cd -> self#content_disposition pp cd
-            | `F_content_transfer_encoding cte ->
-                self#content_transfer_encoding pp cte
-            | `F_content_description text -> self#content_description pp text
-            | `F_content_length len -> self#content_length pp len
-            | `F_content_id id -> self#content_id pp id
-            | f -> super#field pp f
-    end
-*)
+    object
+		inherit emitting ?ct ?cdi ?cte ?cde ?cl ?cid ?u body as super
+		val mutable text_ = lazy (raise Lazy.Undefined)
+		method emit = Lazy.force text_
+		initializer text_ <- Lazy.lazy_from_val super#emit
+	end
 
 (*--- End of File [ mime_entity.ml ] ---*)

File mime/mime_entity.mli

View file
     end
 
 class parsing:
-    (string * char Cf_seq.t) list -> Cf_message.t ->
+    ?h:(string * char Cf_seq.t) list -> Cf_message.t ->
     object('self)
         inherit t
-
-        val body_: Cf_message.t
-        
+		val body_: Cf_message.t        
         method force: unit
-        method put_body: Cf_message.t -> 'self
+		method put_body: Cf_message.t -> 'self
     end
 
 val parse: Cf_message.t -> parsing
 val emit:
     ?ct:ct_t -> ?cdi:cd_t -> ?cte:cte_t -> ?cde:string -> ?cl:int64 ->
     ?cid:(string * string) -> ?u:(string * string) list -> Cf_message.t ->
-    Cf_message.t
-
-(* OBSOLETE! below this line *)
-
-(*
-type f_content_type_t = [ `F_content_type of ct_t ]
-type f_content_disposition_t = [ `F_content_disposition of cd_t ]
-type f_content_transfer_encoding_t = [ `F_content_transfer_encoding of cte_t ]
-type f_content_description_t = [ `F_content_description of string ]
-type f_content_length_t = [ `F_content_length of int64 ]
-type f_content_id_t = [ `F_content_id of string * string ]
-type f_unstructured_t = [ `F_unstructured of string * string ]
-
-type header_field_t = [
-    | f_content_type_t
-    | f_content_disposition_t
-    | f_content_transfer_encoding_t
-    | f_content_description_t
-    | f_content_length_t
-    | f_content_id_t
-    | f_unstructured_t
-]
-
-class ['c, 'f] header_parser:
-    object
-        constraint 'f = [> header_field_t ]
-        inherit ['c, 'f] Mime_parser.t
-        
-        method private content_type: ('c, 'f) Cf_lex.X.t
-        method private content_disposition: ('c, 'f) Cf_lex.X.t
-        method private content_transfer_encoding: ('c, 'f) Cf_lex.X.t
-        method private content_description: ('c, 'f) Cf_lex.X.t
-        method private content_length: ('c, 'f) Cf_lex.X.t
-        method private content_id: ('c, 'f) Cf_lex.X.t
-    end
-
-class ['f] header_emitter:
-    object
-        constraint 'f = [> header_field_t ]
-        inherit ['f] Mime_emitter.t       
-        
-        method private content_type: Format.formatter -> ct_t -> unit
-        method private content_disposition: Format.formatter -> cd_t -> unit
-        method private content_transfer_encoding:
-            Format.formatter -> cte_t -> unit
-        method private content_description: Format.formatter -> string -> unit
-        method private content_length: Format.formatter -> int64 -> unit
-        method private content_id:
-            Format.formatter -> (string * string) -> unit
-    end
-*)
+    emitting
 
 (*--- End of File [ mime_entity.mli ] ---*)