Switch to custom_parser.

CHANGES.md

@@ -1,8 +1,8 @@
 0.3.0 (unreleased)
 =====
 - Add basic example.
-- Add max_size parameter in order to limit the size of parsed tags.
-- id3v2: add on_bigarray
+- Add optional custom parser argument to override the
+  default parsing mechanism.
 
 0.2.0 (2023-07-01)
 =====

examples/basic.ml

@@ -3,4 +3,4 @@
 let () =
   let filename = "test.mp3" in
   let metadata = Metadata.Any.parse_file filename in
-  List.iter (fun (k,v) -> Printf.printf "- %s: %s\n" k v) metadata
+  List.iter (fun (k, v) -> Printf.printf "- %s: %s\n" k v) metadata

examples/meta.ml

@@ -14,7 +14,8 @@ let () =
     match !format with
       | "id3" | "mp3" -> Metadata.ID3.parse_file
       | "id3v1" -> Metadata.ID3v1.parse_file
-      | "id3v2" -> fun f -> Metadata.ID3v2.parse_file f
+      | "id3v2" ->
+          fun ?custom_parser f -> Metadata.ID3v2.parse_file ?custom_parser f
       | "ogg" -> Metadata.OGG.parse_file
       | "mp4" -> Metadata.MP4.parse_file
       | "" -> Metadata.Any.parse_file
@@ -46,18 +47,28 @@ let () =
   List.iter
     (fun fname ->
       Printf.printf "\n# Metadata for %s\n\n%!" fname;
-      let m = parser fname in
+      (* Store "APIC" as custom tag. *)
+      let apic_tag = ref None in
+      let custom_parser ?read_ba ~read:_ ~length:_ ~label () =
+        match (label, read_ba) with
+          | "APIC", Some r -> apic_tag := Some (r ())
+          | _ -> ()
+      in
+      let m = parser ~custom_parser fname in
       List.iter
         (fun (k, v) ->
           let v =
-            if
-              k = "APIC" || k = "PIC"
-              || k = "metadata_block_picture"
-              || k = "RVA2"
-            then "<redacted>"
-            else v
+            match k with
+              | "APIC" -> assert false
+              | "PIC" | "metadata_block_picture" | "RVA2" -> "<redacted>"
+              | _ -> v
           in
           Printf.printf "- %s: %s\n%!" k v;
           if !binary then Printf.printf "  %s: %S\n%!" k v)
-        m)
+        m;
+      match !apic_tag with
+        | None -> ()
+        | Some tag ->
+            Printf.printf "- APIC: <custom tag of length %d>\n"
+              (Bigarray.Array1.dim tag))
     fname

src/metadata.ml

@@ -14,26 +14,26 @@ module Make (E : CharEncoding.T) = struct
   let recode = E.convert
 
   module ID3 = struct
-    let parse ?max_size f =
+    let parse f =
       let failure, v2 =
-        try (false, ID3v2.parse ~recode ?max_size f) with _ -> (true, [])
+        try (false, ID3v2.parse ~recode f) with _ -> (true, [])
       in
       let v1 =
         try
           Reader.reset f;
-          ID3v1.parse ~recode ?max_size f
+          ID3v1.parse ~recode f
         with _ -> if failure then raise Invalid else []
       in
       v2 @ v1
 
-    let parse_file = Reader.with_file parse
+    let parse_file ?custom_parser file =
+      Reader.with_file ?custom_parser parse file
   end
 
-  (** Return the first application which does not raise invalid. *)
-  let rec first_valid l ?(max_size : int option) file =
+  let rec first_valid l file =
     match l with
       | f :: l -> (
-          try f ?max_size file
+          try f file
           with Invalid ->
             Reader.reset file;
             first_valid l file)
@@ -42,25 +42,33 @@ module Make (E : CharEncoding.T) = struct
   module Audio = struct
     let parsers = [ID3.parse; OGG.parse; FLAC.parse]
     let parse = first_valid parsers
-    let parse_file = Reader.with_file parse
+
+    let parse_file ?custom_parser file =
+      Reader.with_file ?custom_parser parse file
   end
 
   module Image = struct
     let parsers = [JPEG.parse; PNG.parse]
     let parse = first_valid parsers
-    let parse_file = Reader.with_file parse
+
+    let parse_file ?custom_parser file =
+      Reader.with_file ?custom_parser parse file
   end
 
   module Video = struct
     let parsers = [AVI.parse; MP4.parse]
     let parse = first_valid parsers
-    let parse_file = Reader.with_file parse
+
+    let parse_file ?custom_parser file =
+      Reader.with_file ?custom_parser parse file
   end
 
   module Any = struct
     let parsers = Audio.parsers @ Image.parsers @ Video.parsers
     let parse = first_valid parsers
-    let parse_file = Reader.with_file parse
+
+    let parse_file ?custom_parser file =
+      Reader.with_file ?custom_parser parse file
   end
 
   include Any

src/metadata.mli

@@ -0,0 +1,163 @@
+module CharEncoding = MetadataCharEncoding
+
+module Make : functor (_ : CharEncoding.T) -> sig
+  exception Invalid
+
+  type endianness = MetadataBase.endianness
+  type metadata = (string * string) list
+
+  type bigarray =
+    (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+  (** When used, a custom parser can override the default parsing mechanism.
+      It is passed the metadata label (without normalization), the expected
+      length of the data, a regular read function an an optional bigarray read
+      function. The custom parser can call any of the read function to get the
+      corresponding tag's value. After doing so, the tag is ignored by the regular
+      parsing process. 
+
+      Currently only supported for: ID3v2, MP4 and [metadata_block_picture] in
+      FLAC metadata. *)
+  type custom_parser =
+    ?read_ba:(unit -> bigarray) ->
+    read:(unit -> string) ->
+    length:int ->
+    label:string ->
+    unit ->
+    unit
+
+  module Reader : sig
+    (** A function to read taking the buffer to fill the offset and the length and
+      returning the number of bytes actually read. *)
+    type t = MetadataBase.Reader.t = {
+      read : bytes -> int -> int -> int;
+      read_ba : (int -> MetadataBase.bigarray) option;
+      custom_parser : custom_parser option;
+      seek : int -> unit;
+      size : unit -> int option;
+      reset : unit -> unit;
+    }
+
+    val read : t -> int -> string
+    val drop : t -> int -> unit
+    val byte : t -> int
+    val uint8 : t -> int
+    val int16_be : t -> int
+    val int16_le : t -> int
+    val uint16_le : t -> int
+    val int16 : endianness -> t -> int
+    val int24_be : t -> int
+    val int32_le : t -> int
+    val uint32_le : t -> int
+    val int32_be : t -> int
+    val size : t -> int option
+
+    (** Go back at the beginning of the stream. *)
+    val reset : t -> unit
+
+    val with_file :
+      ?custom_parser:custom_parser -> (t -> metadata) -> string -> metadata
+
+    val with_string :
+      ?custom_parser:custom_parser -> (t -> metadata) -> string -> metadata
+  end
+
+  module Int : sig
+    type t = int
+
+    val zero : int
+    val one : int
+    val minus_one : int
+    external neg : int -> int = "%negint"
+    external add : int -> int -> int = "%addint"
+    external sub : int -> int -> int = "%subint"
+    external mul : int -> int -> int = "%mulint"
+    external div : int -> int -> int = "%divint"
+    external rem : int -> int -> int = "%modint"
+    external succ : int -> int = "%succint"
+    external pred : int -> int = "%predint"
+    val abs : int -> int
+    val max_int : int
+    val min_int : int
+    external logand : int -> int -> int = "%andint"
+    external logor : int -> int -> int = "%orint"
+    external logxor : int -> int -> int = "%xorint"
+    val lognot : int -> int
+    external shift_left : int -> int -> int = "%lslint"
+    external shift_right : int -> int -> int = "%asrint"
+    external shift_right_logical : int -> int -> int = "%lsrint"
+    val equal : int -> int -> bool
+    val compare : int -> int -> int
+    val min : int -> int -> int
+    val max : int -> int -> int
+    external to_float : int -> float = "%floatofint"
+    external of_float : float -> int = "%intoffloat"
+    val to_string : int -> string
+    val find : (int -> bool) -> int
+  end
+
+  module ID3v1 = MetadataID3v1
+  module ID3v2 = MetadataID3v2
+  module OGG = MetadataOGG
+  module FLAC = MetadataFLAC
+  module JPEG = MetadataJPEG
+  module PNG = MetadataPNG
+  module AVI = MetadataAVI
+  module MP4 = MetadataMP4
+
+  val recode :
+    ?source:[ `ISO_8859_1 | `UTF_16 | `UTF_16BE | `UTF_16LE | `UTF_8 ] ->
+    ?target:[ `UTF_16 | `UTF_16BE | `UTF_16LE | `UTF_8 ] ->
+    string ->
+    string
+
+  module ID3 : sig
+    val parse : Reader.t -> (string * string) list
+
+    val parse_file :
+      ?custom_parser:custom_parser -> string -> (string * string) list
+  end
+
+  (** Return the first application which does not raise invalid. *)
+  val first_valid : (Reader.t -> metadata) list -> Reader.t -> metadata
+
+  module Audio : sig
+    val parsers : (Reader.t -> MetadataBase.metadata) list
+    val parse : Reader.t -> MetadataBase.metadata
+
+    val parse_file :
+      ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  module Image : sig
+    val parsers : (Reader.t -> MetadataBase.metadata) list
+    val parse : Reader.t -> MetadataBase.metadata
+
+    val parse_file :
+      ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  module Video : sig
+    val parsers : (Reader.t -> MetadataBase.metadata) list
+    val parse : Reader.t -> MetadataBase.metadata
+
+    val parse_file :
+      ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  module Any : sig
+    val parsers : (Reader.t -> MetadataBase.metadata) list
+    val parse : Reader.t -> MetadataBase.metadata
+
+    val parse_file :
+      ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  val parsers : (Reader.t -> MetadataBase.metadata) list
+  val parse : Reader.t -> MetadataBase.metadata
+
+  val parse_file :
+    ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+end
+
+include module type of Make (CharEncoding.Naive)

src/metadataAVI.ml

@@ -16,7 +16,7 @@ let tagn =
     ("ISFT", "encoder");
   ]
 
-let parse ?max_size:_ f : metadata =
+let parse f : metadata =
   if R.read f 4 <> "RIFF" then raise Invalid;
   let _ (* file size *) = R.int32_le f in
   if R.read f 4 <> "AVI " then raise Invalid;
@@ -33,18 +33,20 @@ let parse ?max_size:_ f : metadata =
             while !remaining > 0 do
               let tag = R.read f 4 in
               let size = R.int32_le f in
-              let s = R.read f (size - 1) in
-              R.drop f 1;
-              (* null-terminated *)
-              let padding = size mod 2 in
-              R.drop f padding;
-              remaining := !remaining - (8 + size + padding);
-              let tag =
-                match List.assoc_opt tag tagn with
-                  | Some tag -> tag
-                  | None -> tag
-              in
-              ans := (tag, s) :: !ans
+              match R.read_tag ~length:(size - 1) ~label:tag f with
+                | None -> ()
+                | Some s ->
+                    R.drop f 1;
+                    (* null-terminated *)
+                    let padding = size mod 2 in
+                    R.drop f padding;
+                    remaining := !remaining - (8 + size + padding);
+                    let tag =
+                      match List.assoc_opt tag tagn with
+                        | Some tag -> tag
+                        | None -> tag
+                    in
+                    ans := (tag, s) :: !ans
             done
         | "movi" -> raise Exit (* stop parsing there *)
         | _ -> R.drop f (size - 4))
@@ -56,4 +58,4 @@ let parse ?max_size:_ f : metadata =
     assert false
   with _ -> List.rev !ans
 
-let parse_file = R.with_file parse
+let parse_file ?custom_parser file = R.with_file ?custom_parser parse file

src/metadataAVI.mli

@@ -0,0 +1,7 @@
+module R = MetadataBase.Reader
+
+val tagn : (string * string) list
+val parse : R.t -> MetadataBase.metadata
+
+val parse_file :
+  ?custom_parser:MetadataBase.custom_parser -> string -> MetadataBase.metadata