Merge pull request #3 from savonet/bigarray2

Backward compatible bigarray support.

CHANGES.md

@@ -1,6 +1,7 @@
 0.3.0 (unreleased)
 =====
-- Added basic example.
+- Add basic example.
+- Add optional custom parser argument to override the default parsing mechanism.
 
 0.2.0 (2023-07-01)
 =====

examples/basic.ml

@@ -2,4 +2,4 @@
 
 let () =
   let metadata = Metadata.parse_file "test.mp3" 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,7 @@ 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 +46,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 { Metadata.read_ba; 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

@@ -27,10 +27,10 @@ module Make (E : CharEncoding.T) = struct
       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 file =
     match l with
       | f :: l -> (
@@ -43,19 +43,25 @@ 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
@@ -64,11 +70,12 @@ module Make (E : CharEncoding.T) = struct
     (** Genering parsing of metadata. *)
     let parse = first_valid parsers
 
-    (** Parse the metadatas of a file. *)
-    let parse_file = Reader.with_file parse
+    let parse_file ?custom_parser file =
+      Reader.with_file ?custom_parser parse file
 
     (** Parse the metadatas of a string. *)
-    let parse_string = Reader.with_string parse
+    let parse_string ?custom_parser file =
+      Reader.with_string ?custom_parser parse file
   end
 
   include Any

src/metadata.mli

@@ -0,0 +1,137 @@
+(** Read metadata from various file formats. *)
+
+(** Functions for handling charset conversion. *)
+module CharEncoding = MetadataCharEncoding
+
+(** Generate metadata parsers given functions for converting charsets. *)
+module Make : functor (_ : CharEncoding.T) -> sig
+  (** Raised when the metadata is not valid. *)
+  exception Invalid
+
+  (** Metadata are represented as association lists (name, value). *)
+  type metadata = (string * string) list
+
+  (** Bigarray representation of (large) tags. *)
+  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 parser_handler = MetadataBase.parser_handler = {
+    label : string;
+    length : int;
+    read : unit -> string;
+    read_ba : (unit -> bigarray) option;
+    skip : unit -> unit;
+  }
+
+  (** A custom parser, see [parser_handler]. *)
+  type custom_parser = parser_handler -> unit
+
+  (** Abstractions for reading from various sources. *)
+  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;
+    }
+
+    (** Go back at the beginning of the stream. *)
+    val reset : t -> unit
+
+    (** Specialize a parser to operate on files. *)
+    val with_file : ?custom_parser:custom_parser -> (t -> metadata) -> string -> metadata
+
+    (** Specialize a parser to operate on strings. *)
+    val with_string : ?custom_parser:custom_parser -> (t -> metadata) -> string -> metadata
+  end
+
+  (** ID3v1 metadata.*)
+  module ID3v1 = MetadataID3v1
+
+  (** ID3v2 metadata. *)
+  module ID3v2 = MetadataID3v2
+
+  (** OGG metadata. *)
+  module OGG = MetadataOGG
+
+  (** Flac metadata. *)
+  module FLAC = MetadataFLAC
+
+  (** Jpeg metadata. *)
+  module JPEG = MetadataJPEG
+
+  (** PNG metadata. *)
+  module PNG = MetadataPNG
+
+  (** AVI metadata. *)
+  module AVI = MetadataAVI
+
+  (** MP4 metadata. *)
+  module MP4 = MetadataMP4
+
+  (** Convert the charset encoding of a string. *)
+  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
+
+  (** ID3v1 and ID3v2 metadata. *)
+  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
+
+  (** Audio file formats. *)
+  module Audio : sig
+    val parse : Reader.t -> MetadataBase.metadata
+
+    val parse_file : ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  (** Image file formats. *)
+  module Image : sig
+    val parse : Reader.t -> MetadataBase.metadata
+
+    val parse_file : ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  (** Video file formats. *)
+  module Video : sig
+    val parse : Reader.t -> MetadataBase.metadata
+
+    val parse_file : ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  (** All support file formats. *)
+  module Any : sig
+    (** Generic metadata parsing. *)
+    val parse : Reader.t -> MetadataBase.metadata
+
+    (** Parse the metadata from a file. *)
+    val parse_file : ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+
+    (** Parse the metadata from a string containing the contents of a file. *)
+    val parse_string : ?custom_parser:custom_parser -> string -> MetadataBase.metadata
+  end
+
+  include module type of Any
+end
+
+include module type of Make (CharEncoding.Naive)

src/metadataAVI.ml

@@ -33,18 +33,20 @@ let parse 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 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,3 @@
+val parse : MetadataBase.Reader.t -> MetadataBase.metadata
+
+val parse_file : ?custom_parser:MetadataBase.custom_parser -> string -> MetadataBase.metadata