this repo has no description
more
+2921
+5
project/ocaml-exif/bin/dune
+5
project/ocaml-exif/bin/dune
+88
project/ocaml-exif/bin/exifdump.ml
+88
project/ocaml-exif/bin/exifdump.ml
···
1
+
(** exifdump - Extract and display EXIF metadata from JPEG files
2
+
3
+
Usage: exifdump [OPTIONS] FILE...
4
+
5
+
Options:
6
+
-j, --json Output as JSON
7
+
-m, --minify Minify JSON output (implies --json)
8
+
-q, --quiet Only show errors
9
+
-h, --help Show this help message *)
10
+
11
+
let usage =
12
+
{|exifdump - Extract and display EXIF metadata from JPEG files
13
+
14
+
Usage: exifdump [OPTIONS] FILE...
15
+
16
+
Options:
17
+
-j, --json Output as JSON
18
+
-m, --minify Minify JSON output (implies --json)
19
+
-q, --quiet Only show errors
20
+
-h, --help Show this help message
21
+
22
+
Examples:
23
+
exifdump photo.jpg
24
+
exifdump -j photo.jpg > exif.json
25
+
exifdump *.jpg|}
26
+
27
+
type output_format = Pretty | Json | JsonMinified
28
+
29
+
let output_format = ref Pretty
30
+
let quiet = ref false
31
+
let files = ref []
32
+
33
+
let parse_args () =
34
+
let args = Array.to_list Sys.argv |> List.tl in
35
+
let rec parse = function
36
+
| [] -> ()
37
+
| ("-h" | "--help") :: _ ->
38
+
print_endline usage;
39
+
exit 0
40
+
| ("-j" | "--json") :: rest ->
41
+
output_format := Json;
42
+
parse rest
43
+
| ("-m" | "--minify") :: rest ->
44
+
output_format := JsonMinified;
45
+
parse rest
46
+
| ("-q" | "--quiet") :: rest ->
47
+
quiet := true;
48
+
parse rest
49
+
| arg :: _ when String.length arg > 0 && arg.[0] = '-' ->
50
+
Printf.eprintf "Unknown option: %s\n" arg;
51
+
exit 1
52
+
| file :: rest ->
53
+
files := file :: !files;
54
+
parse rest
55
+
in
56
+
parse args;
57
+
files := List.rev !files
58
+
59
+
let process_file filename =
60
+
match Exif_jpeg.from_file filename with
61
+
| Error e ->
62
+
Printf.eprintf "%s: %s\n" filename (Exif_jpeg.string_of_error e);
63
+
false
64
+
| Ok exif ->
65
+
if not !quiet then begin
66
+
match !output_format with
67
+
| Pretty ->
68
+
Printf.printf "=== %s ===\n" filename;
69
+
print_endline (Exif_pp.to_string exif);
70
+
print_newline ()
71
+
| Json ->
72
+
Printf.printf "%s\n" (Exif_json.to_json_string ~minify:false exif)
73
+
| JsonMinified ->
74
+
Printf.printf "%s\n" (Exif_json.to_json_string ~minify:true exif)
75
+
end;
76
+
true
77
+
78
+
let () =
79
+
parse_args ();
80
+
if !files = [] then begin
81
+
prerr_endline "Error: No files specified";
82
+
prerr_endline "Usage: exifdump [OPTIONS] FILE...";
83
+
prerr_endline "Try 'exifdump --help' for more information.";
84
+
exit 1
85
+
end;
86
+
let results = List.map process_file !files in
87
+
let failed = List.filter (fun x -> not x) results in
88
+
if failed <> [] then exit 1
+40
project/ocaml-exif/dune-project
+40
project/ocaml-exif/dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name ocaml-exif)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(source
8
+
(github mymatrix/ocaml-exif))
9
+
10
+
(authors "MyMatrix Contributors")
11
+
12
+
(maintainers "maintainer@example.com")
13
+
14
+
(license ISC)
15
+
16
+
(documentation https://github.com/mymatrix/ocaml-exif)
17
+
18
+
(package
19
+
(name ocaml-exif)
20
+
(synopsis "Pure OCaml EXIF metadata parsing library")
21
+
(description
22
+
"A pure OCaml implementation of EXIF (Exchangeable Image File Format) parsing based on EXIF 2.32 and TIFF 6.0 specifications. Supports all standard EXIF tags, GPS data, thumbnail extraction, and both big-endian and little-endian byte orders.")
23
+
(depends
24
+
(ocaml (>= 4.14.0))
25
+
(alcotest :with-test))
26
+
(tags
27
+
(exif metadata jpeg tiff gps image)))
28
+
29
+
(package
30
+
(name ocaml-exif-json)
31
+
(synopsis "JSON serialization for ocaml-exif")
32
+
(description
33
+
"Jsont-based JSON codecs for EXIF metadata. Provides bidirectional JSON encoding for EXIF types, enabling interoperability with JavaScript and web APIs.")
34
+
(depends
35
+
(ocaml (>= 4.14.0))
36
+
(ocaml-exif (= :version))
37
+
jsont
38
+
base64)
39
+
(tags
40
+
(exif json serialization)))
+35
project/ocaml-exif/ocaml-exif-json.opam
+35
project/ocaml-exif/ocaml-exif-json.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "JSON serialization for ocaml-exif"
4
+
description:
5
+
"Jsont-based JSON codecs for EXIF metadata. Provides bidirectional JSON encoding for EXIF types, enabling interoperability with JavaScript and web APIs."
6
+
maintainer: ["maintainer@example.com"]
7
+
authors: ["MyMatrix Contributors"]
8
+
license: "ISC"
9
+
tags: ["exif" "json" "serialization"]
10
+
homepage: "https://github.com/mymatrix/ocaml-exif"
11
+
doc: "https://github.com/mymatrix/ocaml-exif"
12
+
bug-reports: "https://github.com/mymatrix/ocaml-exif/issues"
13
+
depends: [
14
+
"dune" {>= "3.0"}
15
+
"ocaml" {>= "4.14.0"}
16
+
"ocaml-exif" {= version}
17
+
"jsont"
18
+
"base64"
19
+
"odoc" {with-doc}
20
+
]
21
+
build: [
22
+
["dune" "subst"] {dev}
23
+
[
24
+
"dune"
25
+
"build"
26
+
"-p"
27
+
name
28
+
"-j"
29
+
jobs
30
+
"@install"
31
+
"@runtest" {with-test}
32
+
"@doc" {with-doc}
33
+
]
34
+
]
35
+
dev-repo: "git+https://github.com/mymatrix/ocaml-exif.git"
+33
project/ocaml-exif/ocaml-exif.opam
+33
project/ocaml-exif/ocaml-exif.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Pure OCaml EXIF metadata parsing library"
4
+
description:
5
+
"A pure OCaml implementation of EXIF (Exchangeable Image File Format) parsing based on EXIF 2.32 and TIFF 6.0 specifications. Supports all standard EXIF tags, GPS data, thumbnail extraction, and both big-endian and little-endian byte orders."
6
+
maintainer: ["maintainer@example.com"]
7
+
authors: ["MyMatrix Contributors"]
8
+
license: "ISC"
9
+
tags: ["exif" "metadata" "jpeg" "tiff" "gps" "image"]
10
+
homepage: "https://github.com/mymatrix/ocaml-exif"
11
+
doc: "https://github.com/mymatrix/ocaml-exif"
12
+
bug-reports: "https://github.com/mymatrix/ocaml-exif/issues"
13
+
depends: [
14
+
"dune" {>= "3.0"}
15
+
"ocaml" {>= "4.14.0"}
16
+
"alcotest" {with-test}
17
+
"odoc" {with-doc}
18
+
]
19
+
build: [
20
+
["dune" "subst"] {dev}
21
+
[
22
+
"dune"
23
+
"build"
24
+
"-p"
25
+
name
26
+
"-j"
27
+
jobs
28
+
"@install"
29
+
"@runtest" {with-test}
30
+
"@doc" {with-doc}
31
+
]
32
+
]
33
+
dev-repo: "git+https://github.com/mymatrix/ocaml-exif.git"
+4
project/ocaml-exif/src-json/dune
+4
project/ocaml-exif/src-json/dune
+166
project/ocaml-exif/src-json/exif_json.ml
+166
project/ocaml-exif/src-json/exif_json.ml
···
1
+
(** JSON codecs for EXIF data
2
+
3
+
Provides Jsont-based JSON encoding for EXIF types. *)
4
+
5
+
open Exif
6
+
7
+
(** {1 Base Type Codecs} *)
8
+
9
+
let byte_order_jsont =
10
+
let dec : string -> byte_order = function
11
+
| "big-endian" | "MM" -> Big_endian
12
+
| "little-endian" | "II" -> Little_endian
13
+
| s -> failwith ("Unknown byte order: " ^ s)
14
+
in
15
+
let enc : byte_order -> string = function
16
+
| Big_endian -> "big-endian"
17
+
| Little_endian -> "little-endian"
18
+
in
19
+
Jsont.Base.string
20
+
(Jsont.Base.map ~dec:(Jsont.Base.dec_failure dec) ~enc ())
21
+
22
+
let format_jsont =
23
+
let dec : string -> format = function
24
+
| "BYTE" -> Byte
25
+
| "ASCII" -> Ascii
26
+
| "SHORT" -> Short
27
+
| "LONG" -> Long
28
+
| "RATIONAL" -> Rational
29
+
| "SBYTE" -> Sbyte
30
+
| "UNDEFINED" -> Undefined
31
+
| "SSHORT" -> Sshort
32
+
| "SLONG" -> Slong
33
+
| "SRATIONAL" -> Srational
34
+
| "FLOAT" -> Float
35
+
| "DOUBLE" -> Double
36
+
| s -> failwith ("Unknown format: " ^ s)
37
+
in
38
+
let enc : format -> string = function
39
+
| Byte -> "BYTE"
40
+
| Ascii -> "ASCII"
41
+
| Short -> "SHORT"
42
+
| Long -> "LONG"
43
+
| Rational -> "RATIONAL"
44
+
| Sbyte -> "SBYTE"
45
+
| Undefined -> "UNDEFINED"
46
+
| Sshort -> "SSHORT"
47
+
| Slong -> "SLONG"
48
+
| Srational -> "SRATIONAL"
49
+
| Float -> "FLOAT"
50
+
| Double -> "DOUBLE"
51
+
in
52
+
Jsont.Base.string
53
+
(Jsont.Base.map ~dec:(Jsont.Base.dec_failure dec) ~enc ())
54
+
55
+
let ifd_jsont =
56
+
let dec : string -> ifd = function
57
+
| "IFD0" -> IFD0
58
+
| "IFD1" -> IFD1
59
+
| "EXIF" -> EXIF
60
+
| "GPS" -> GPS
61
+
| "Interoperability" -> Interoperability
62
+
| s -> failwith ("Unknown IFD: " ^ s)
63
+
in
64
+
let enc : ifd -> string = function
65
+
| IFD0 -> "IFD0"
66
+
| IFD1 -> "IFD1"
67
+
| EXIF -> "EXIF"
68
+
| GPS -> "GPS"
69
+
| Interoperability -> "Interoperability"
70
+
in
71
+
Jsont.Base.string
72
+
(Jsont.Base.map ~dec:(Jsont.Base.dec_failure dec) ~enc ())
73
+
74
+
(** {1 Rational Codecs} *)
75
+
76
+
let rational_jsont =
77
+
let open Jsont.Object in
78
+
map (fun numerator denominator -> { numerator; denominator })
79
+
|> mem "numerator" Jsont.int32 ~enc:(fun r -> r.numerator)
80
+
|> mem "denominator" Jsont.int32 ~enc:(fun r -> r.denominator)
81
+
|> finish
82
+
83
+
let srational_jsont =
84
+
let open Jsont.Object in
85
+
map (fun snumerator sdenominator -> { snumerator; sdenominator })
86
+
|> mem "numerator" Jsont.int32 ~enc:(fun r -> r.snumerator)
87
+
|> mem "denominator" Jsont.int32 ~enc:(fun r -> r.sdenominator)
88
+
|> finish
89
+
90
+
(** {1 Bytes Codec} *)
91
+
92
+
(* Encode bytes as base64 *)
93
+
let bytes_jsont =
94
+
let dec : string -> bytes = fun s ->
95
+
match Base64.decode s with
96
+
| Ok decoded -> Bytes.of_string decoded
97
+
| Error (`Msg msg) -> failwith msg
98
+
in
99
+
let enc : bytes -> string = fun b ->
100
+
Base64.encode_string (Bytes.to_string b)
101
+
in
102
+
Jsont.Base.string
103
+
(Jsont.Base.map ~dec:(Jsont.Base.dec_failure dec) ~enc ())
104
+
105
+
(** {1 Value Codec}
106
+
107
+
Values are encoded as string representation for display.
108
+
For full round-trip, would need structured encoding. *)
109
+
110
+
let value_string_jsont =
111
+
let enc : value -> string = Exif.string_of_value in
112
+
let dec : string -> value = fun _ ->
113
+
failwith "Cannot decode value from string representation"
114
+
in
115
+
Jsont.Base.string
116
+
(Jsont.Base.map ~dec:(Jsont.Base.dec_failure dec) ~enc ())
117
+
118
+
(** {1 Entry Codec} *)
119
+
120
+
let entry_jsont =
121
+
let open Jsont.Object in
122
+
map (fun tag _tag_hex _tag_name ifd format components value ->
123
+
ignore value;
124
+
{ tag; ifd; format; components; value = VByte [||] })
125
+
|> mem "tag" Jsont.int ~enc:(fun e -> e.tag)
126
+
|> mem "tag_hex" Jsont.string ~enc:(fun e -> Printf.sprintf "0x%04X" e.tag)
127
+
~dec_absent:""
128
+
|> mem "tag_name" Jsont.string ~enc:(fun e -> Exif.Tag.name_of_tag e.tag e.ifd)
129
+
~dec_absent:""
130
+
|> mem "ifd" ifd_jsont ~enc:(fun e -> e.ifd)
131
+
|> mem "format" format_jsont ~enc:(fun e -> e.format)
132
+
|> mem "components" Jsont.int ~enc:(fun e -> e.components)
133
+
|> mem "value" value_string_jsont ~enc:(fun e -> e.value)
134
+
|> finish
135
+
136
+
(** {1 Complete EXIF Codec} *)
137
+
138
+
let exif_jsont =
139
+
let open Jsont.Object in
140
+
map (fun byte_order entries thumbnail ->
141
+
ignore thumbnail;
142
+
{ byte_order; entries; thumbnail = None })
143
+
|> mem "byte_order" byte_order_jsont ~enc:(fun e -> e.byte_order)
144
+
|> mem "entries" (Jsont.list entry_jsont) ~enc:(fun e -> e.entries)
145
+
|> opt_mem "thumbnail_base64" bytes_jsont ~enc:(fun e -> e.thumbnail)
146
+
|> finish
147
+
148
+
(** {1 Convenience Encoding Functions} *)
149
+
150
+
let to_json_string ?(minify = false) exif =
151
+
let format =
152
+
if minify then Jsont.Minify
153
+
else Jsont.Indent
154
+
in
155
+
match Jsont_bytesrw.encode_string ~format exif_jsont exif with
156
+
| Ok s -> s
157
+
| Error e -> failwith e
158
+
159
+
let entry_to_json_string ?(minify = false) entry =
160
+
let format =
161
+
if minify then Jsont.Minify
162
+
else Jsont.Indent
163
+
in
164
+
match Jsont_bytesrw.encode_string ~format entry_jsont entry with
165
+
| Ok s -> s
166
+
| Error e -> failwith e
+89
project/ocaml-exif/src-json/exif_json.mli
+89
project/ocaml-exif/src-json/exif_json.mli
···
1
+
(** {1 JSON Codecs for EXIF Data}
2
+
3
+
Jsont-based JSON encoding for EXIF types.
4
+
This module provides JSON serialization for EXIF metadata,
5
+
useful for interoperability with JavaScript, web APIs, and data exchange.
6
+
7
+
{2 Example}
8
+
9
+
{[
10
+
let exif = Exif_jpeg.from_file "photo.jpg" |> Result.get_ok in
11
+
let json = Exif_json.to_json_string exif in
12
+
print_endline json
13
+
]}
14
+
15
+
{2 JSON Format}
16
+
17
+
The JSON output uses the following structure:
18
+
19
+
{v
20
+
{
21
+
"byte_order": "little-endian",
22
+
"entries": [
23
+
{
24
+
"tag": 271,
25
+
"tag_hex": "0x010F",
26
+
"tag_name": "Make",
27
+
"ifd": "IFD0",
28
+
"format": "ASCII",
29
+
"components": 6,
30
+
"value": "Canon"
31
+
},
32
+
...
33
+
],
34
+
"thumbnail_base64": "..." // optional, base64-encoded JPEG
35
+
}
36
+
v}
37
+
38
+
@see <https://erratique.ch/software/jsont> Jsont library *)
39
+
40
+
open Exif
41
+
42
+
(** {1 Type Codecs}
43
+
44
+
Jsont codecs for individual EXIF types.
45
+
These can be composed with other Jsont combinators. *)
46
+
47
+
val byte_order_jsont : byte_order Jsont.t
48
+
(** Codec for byte order. Encodes as "big-endian" or "little-endian". *)
49
+
50
+
val format_jsont : format Jsont.t
51
+
(** Codec for data format. Encodes as uppercase type names
52
+
(e.g., "BYTE", "ASCII", "RATIONAL"). *)
53
+
54
+
val ifd_jsont : ifd Jsont.t
55
+
(** Codec for IFD type. Encodes as "IFD0", "IFD1", "EXIF", "GPS",
56
+
or "Interoperability". *)
57
+
58
+
val rational_jsont : rational Jsont.t
59
+
(** Codec for unsigned rational numbers.
60
+
Encodes as {v {"numerator": n, "denominator": d} v}. *)
61
+
62
+
val srational_jsont : srational Jsont.t
63
+
(** Codec for signed rational numbers.
64
+
Encodes as {v {"numerator": n, "denominator": d} v}. *)
65
+
66
+
val bytes_jsont : bytes Jsont.t
67
+
(** Codec for binary data. Encodes as base64 string. *)
68
+
69
+
val entry_jsont : entry Jsont.t
70
+
(** Codec for EXIF entries. Includes tag number, hex representation,
71
+
human-readable name, IFD, format, component count, and value. *)
72
+
73
+
val exif_jsont : t Jsont.t
74
+
(** Codec for complete EXIF data. *)
75
+
76
+
(** {1 Encoding Functions} *)
77
+
78
+
val to_json_string : ?minify:bool -> t -> string
79
+
(** Encode EXIF data to JSON string.
80
+
81
+
@param minify If [true], produce compact output without whitespace.
82
+
Default is [false] for pretty-printed output.
83
+
@raise Failure on encoding error (should not happen with valid EXIF) *)
84
+
85
+
val entry_to_json_string : ?minify:bool -> entry -> string
86
+
(** Encode a single EXIF entry to JSON string.
87
+
88
+
@param minify If [true], produce compact output.
89
+
@raise Failure on encoding error *)
+5
project/ocaml-exif/src/dune
+5
project/ocaml-exif/src/dune
+821
project/ocaml-exif/src/exif.ml
+821
project/ocaml-exif/src/exif.ml
···
1
+
(** Pure OCaml EXIF parsing library
2
+
3
+
Based on EXIF 2.32 specification and TIFF 6.0 specification.
4
+
5
+
EXIF data is stored in JPEG APP1 markers with the prefix "Exif\x00\x00".
6
+
The data follows TIFF format with IFDs (Image File Directories). *)
7
+
8
+
(** {1 Types} *)
9
+
10
+
type byte_order =
11
+
| Big_endian
12
+
| Little_endian
13
+
14
+
type format =
15
+
| Byte
16
+
| Ascii
17
+
| Short
18
+
| Long
19
+
| Rational
20
+
| Sbyte
21
+
| Undefined
22
+
| Sshort
23
+
| Slong
24
+
| Srational
25
+
| Float
26
+
| Double
27
+
28
+
type ifd =
29
+
| IFD0
30
+
| IFD1
31
+
| EXIF
32
+
| GPS
33
+
| Interoperability
34
+
35
+
type rational = {
36
+
numerator : int32;
37
+
denominator : int32;
38
+
}
39
+
40
+
type srational = {
41
+
snumerator : int32;
42
+
sdenominator : int32;
43
+
}
44
+
45
+
type value =
46
+
| VByte of int array
47
+
| VAscii of string
48
+
| VShort of int array
49
+
| VLong of int32 array
50
+
| VRational of rational array
51
+
| VSbyte of int array
52
+
| VUndefined of bytes
53
+
| VSshort of int array
54
+
| VSlong of int32 array
55
+
| VSrational of srational array
56
+
| VFloat of float array
57
+
| VDouble of float array
58
+
59
+
type entry = {
60
+
tag : int;
61
+
ifd : ifd;
62
+
format : format;
63
+
components : int;
64
+
value : value;
65
+
}
66
+
67
+
type t = {
68
+
byte_order : byte_order;
69
+
entries : entry list;
70
+
thumbnail : bytes option;
71
+
}
72
+
73
+
(** {1 Tag constants} *)
74
+
75
+
module Tag = struct
76
+
(* IFD0/IFD1 tags - TIFF 6.0 baseline *)
77
+
let image_width = 0x0100
78
+
let image_length = 0x0101
79
+
let bits_per_sample = 0x0102
80
+
let compression = 0x0103
81
+
let photometric_interpretation = 0x0106
82
+
let image_description = 0x010E
83
+
let make = 0x010F
84
+
let model = 0x0110
85
+
let strip_offsets = 0x0111
86
+
let orientation = 0x0112
87
+
let samples_per_pixel = 0x0115
88
+
let rows_per_strip = 0x0116
89
+
let strip_byte_counts = 0x0117
90
+
let x_resolution = 0x011A
91
+
let y_resolution = 0x011B
92
+
let planar_configuration = 0x011C
93
+
let resolution_unit = 0x0128
94
+
let transfer_function = 0x012D
95
+
let software = 0x0131
96
+
let date_time = 0x0132
97
+
let artist = 0x013B
98
+
let white_point = 0x013E
99
+
let primary_chromaticities = 0x013F
100
+
let jpeg_interchange_format = 0x0201
101
+
let jpeg_interchange_format_length = 0x0202
102
+
let ycbcr_coefficients = 0x0211
103
+
let ycbcr_sub_sampling = 0x0212
104
+
let ycbcr_positioning = 0x0213
105
+
let reference_black_white = 0x0214
106
+
let copyright = 0x8298
107
+
let exif_ifd_pointer = 0x8769
108
+
let gps_info_ifd_pointer = 0x8825
109
+
110
+
(* EXIF IFD tags - camera/exposure settings *)
111
+
let exposure_time = 0x829A
112
+
let f_number = 0x829D
113
+
let exposure_program = 0x8822
114
+
let spectral_sensitivity = 0x8824
115
+
let iso_speed_ratings = 0x8827
116
+
let oecf = 0x8828
117
+
let sensitivity_type = 0x8830
118
+
let exif_version = 0x9000
119
+
let date_time_original = 0x9003
120
+
let date_time_digitized = 0x9004
121
+
let offset_time = 0x9010
122
+
let offset_time_original = 0x9011
123
+
let offset_time_digitized = 0x9012
124
+
let components_configuration = 0x9101
125
+
let compressed_bits_per_pixel = 0x9102
126
+
let shutter_speed_value = 0x9201
127
+
let aperture_value = 0x9202
128
+
let brightness_value = 0x9203
129
+
let exposure_bias_value = 0x9204
130
+
let max_aperture_value = 0x9205
131
+
let subject_distance = 0x9206
132
+
let metering_mode = 0x9207
133
+
let light_source = 0x9208
134
+
let flash = 0x9209
135
+
let focal_length = 0x920A
136
+
let subject_area = 0x9214
137
+
let maker_note = 0x927C
138
+
let user_comment = 0x9286
139
+
let sub_sec_time = 0x9290
140
+
let sub_sec_time_original = 0x9291
141
+
let sub_sec_time_digitized = 0x9292
142
+
let flash_pix_version = 0xA000
143
+
let color_space = 0xA001
144
+
let pixel_x_dimension = 0xA002
145
+
let pixel_y_dimension = 0xA003
146
+
let related_sound_file = 0xA004
147
+
let interoperability_ifd_pointer = 0xA005
148
+
let flash_energy = 0xA20B
149
+
let spatial_frequency_response = 0xA20C
150
+
let focal_plane_x_resolution = 0xA20E
151
+
let focal_plane_y_resolution = 0xA20F
152
+
let focal_plane_resolution_unit = 0xA210
153
+
let subject_location = 0xA214
154
+
let exposure_index = 0xA215
155
+
let sensing_method = 0xA217
156
+
let file_source = 0xA300
157
+
let scene_type = 0xA301
158
+
let cfa_pattern = 0xA302
159
+
let custom_rendered = 0xA401
160
+
let exposure_mode = 0xA402
161
+
let white_balance = 0xA403
162
+
let digital_zoom_ratio = 0xA404
163
+
let focal_length_in_35mm_film = 0xA405
164
+
let scene_capture_type = 0xA406
165
+
let gain_control = 0xA407
166
+
let contrast = 0xA408
167
+
let saturation = 0xA409
168
+
let sharpness = 0xA40A
169
+
let device_setting_description = 0xA40B
170
+
let subject_distance_range = 0xA40C
171
+
let image_unique_id = 0xA420
172
+
let camera_owner_name = 0xA430
173
+
let body_serial_number = 0xA431
174
+
let lens_specification = 0xA432
175
+
let lens_make = 0xA433
176
+
let lens_model = 0xA434
177
+
let lens_serial_number = 0xA435
178
+
let gamma = 0xA500
179
+
180
+
(* GPS IFD tags *)
181
+
let gps_version_id = 0x0000
182
+
let gps_latitude_ref = 0x0001
183
+
let gps_latitude = 0x0002
184
+
let gps_longitude_ref = 0x0003
185
+
let gps_longitude = 0x0004
186
+
let gps_altitude_ref = 0x0005
187
+
let gps_altitude = 0x0006
188
+
let gps_time_stamp = 0x0007
189
+
let gps_satellites = 0x0008
190
+
let gps_status = 0x0009
191
+
let gps_measure_mode = 0x000A
192
+
let gps_dop = 0x000B
193
+
let gps_speed_ref = 0x000C
194
+
let gps_speed = 0x000D
195
+
let gps_track_ref = 0x000E
196
+
let gps_track = 0x000F
197
+
let gps_img_direction_ref = 0x0010
198
+
let gps_img_direction = 0x0011
199
+
let gps_map_datum = 0x0012
200
+
let gps_dest_latitude_ref = 0x0013
201
+
let gps_dest_latitude = 0x0014
202
+
let gps_dest_longitude_ref = 0x0015
203
+
let gps_dest_longitude = 0x0016
204
+
let gps_dest_bearing_ref = 0x0017
205
+
let gps_dest_bearing = 0x0018
206
+
let gps_dest_distance_ref = 0x0019
207
+
let gps_dest_distance = 0x001A
208
+
let gps_processing_method = 0x001B
209
+
let gps_area_information = 0x001C
210
+
let gps_date_stamp = 0x001D
211
+
let gps_differential = 0x001E
212
+
let gps_h_positioning_error = 0x001F
213
+
214
+
let name_of_tag tag ifd =
215
+
match ifd with
216
+
| GPS ->
217
+
(match tag with
218
+
| 0x0000 -> "GPSVersionID"
219
+
| 0x0001 -> "GPSLatitudeRef"
220
+
| 0x0002 -> "GPSLatitude"
221
+
| 0x0003 -> "GPSLongitudeRef"
222
+
| 0x0004 -> "GPSLongitude"
223
+
| 0x0005 -> "GPSAltitudeRef"
224
+
| 0x0006 -> "GPSAltitude"
225
+
| 0x0007 -> "GPSTimeStamp"
226
+
| 0x0008 -> "GPSSatellites"
227
+
| 0x0009 -> "GPSStatus"
228
+
| 0x000A -> "GPSMeasureMode"
229
+
| 0x000B -> "GPSDOP"
230
+
| 0x000C -> "GPSSpeedRef"
231
+
| 0x000D -> "GPSSpeed"
232
+
| 0x000E -> "GPSTrackRef"
233
+
| 0x000F -> "GPSTrack"
234
+
| 0x0010 -> "GPSImgDirectionRef"
235
+
| 0x0011 -> "GPSImgDirection"
236
+
| 0x0012 -> "GPSMapDatum"
237
+
| 0x001D -> "GPSDateStamp"
238
+
| _ -> Printf.sprintf "GPS_0x%04X" tag)
239
+
| _ ->
240
+
(match tag with
241
+
| 0x0100 -> "ImageWidth"
242
+
| 0x0101 -> "ImageLength"
243
+
| 0x0102 -> "BitsPerSample"
244
+
| 0x0103 -> "Compression"
245
+
| 0x0106 -> "PhotometricInterpretation"
246
+
| 0x010E -> "ImageDescription"
247
+
| 0x010F -> "Make"
248
+
| 0x0110 -> "Model"
249
+
| 0x0111 -> "StripOffsets"
250
+
| 0x0112 -> "Orientation"
251
+
| 0x0115 -> "SamplesPerPixel"
252
+
| 0x0116 -> "RowsPerStrip"
253
+
| 0x0117 -> "StripByteCounts"
254
+
| 0x011A -> "XResolution"
255
+
| 0x011B -> "YResolution"
256
+
| 0x011C -> "PlanarConfiguration"
257
+
| 0x0128 -> "ResolutionUnit"
258
+
| 0x012D -> "TransferFunction"
259
+
| 0x0131 -> "Software"
260
+
| 0x0132 -> "DateTime"
261
+
| 0x013B -> "Artist"
262
+
| 0x013E -> "WhitePoint"
263
+
| 0x013F -> "PrimaryChromaticities"
264
+
| 0x0201 -> "JPEGInterchangeFormat"
265
+
| 0x0202 -> "JPEGInterchangeFormatLength"
266
+
| 0x0211 -> "YCbCrCoefficients"
267
+
| 0x0212 -> "YCbCrSubSampling"
268
+
| 0x0213 -> "YCbCrPositioning"
269
+
| 0x0214 -> "ReferenceBlackWhite"
270
+
| 0x8298 -> "Copyright"
271
+
| 0x8769 -> "ExifIFDPointer"
272
+
| 0x8825 -> "GPSInfoIFDPointer"
273
+
| 0x829A -> "ExposureTime"
274
+
| 0x829D -> "FNumber"
275
+
| 0x8822 -> "ExposureProgram"
276
+
| 0x8824 -> "SpectralSensitivity"
277
+
| 0x8827 -> "ISOSpeedRatings"
278
+
| 0x9000 -> "ExifVersion"
279
+
| 0x9003 -> "DateTimeOriginal"
280
+
| 0x9004 -> "DateTimeDigitized"
281
+
| 0x9010 -> "OffsetTime"
282
+
| 0x9011 -> "OffsetTimeOriginal"
283
+
| 0x9012 -> "OffsetTimeDigitized"
284
+
| 0x9101 -> "ComponentsConfiguration"
285
+
| 0x9102 -> "CompressedBitsPerPixel"
286
+
| 0x9201 -> "ShutterSpeedValue"
287
+
| 0x9202 -> "ApertureValue"
288
+
| 0x9203 -> "BrightnessValue"
289
+
| 0x9204 -> "ExposureBiasValue"
290
+
| 0x9205 -> "MaxApertureValue"
291
+
| 0x9206 -> "SubjectDistance"
292
+
| 0x9207 -> "MeteringMode"
293
+
| 0x9208 -> "LightSource"
294
+
| 0x9209 -> "Flash"
295
+
| 0x920A -> "FocalLength"
296
+
| 0x9214 -> "SubjectArea"
297
+
| 0x927C -> "MakerNote"
298
+
| 0x9286 -> "UserComment"
299
+
| 0x9290 -> "SubSecTime"
300
+
| 0x9291 -> "SubSecTimeOriginal"
301
+
| 0x9292 -> "SubSecTimeDigitized"
302
+
| 0xA000 -> "FlashPixVersion"
303
+
| 0xA001 -> "ColorSpace"
304
+
| 0xA002 -> "PixelXDimension"
305
+
| 0xA003 -> "PixelYDimension"
306
+
| 0xA004 -> "RelatedSoundFile"
307
+
| 0xA005 -> "InteroperabilityIFDPointer"
308
+
| 0xA20B -> "FlashEnergy"
309
+
| 0xA20C -> "SpatialFrequencyResponse"
310
+
| 0xA20E -> "FocalPlaneXResolution"
311
+
| 0xA20F -> "FocalPlaneYResolution"
312
+
| 0xA210 -> "FocalPlaneResolutionUnit"
313
+
| 0xA214 -> "SubjectLocation"
314
+
| 0xA215 -> "ExposureIndex"
315
+
| 0xA217 -> "SensingMethod"
316
+
| 0xA300 -> "FileSource"
317
+
| 0xA301 -> "SceneType"
318
+
| 0xA302 -> "CFAPattern"
319
+
| 0xA401 -> "CustomRendered"
320
+
| 0xA402 -> "ExposureMode"
321
+
| 0xA403 -> "WhiteBalance"
322
+
| 0xA404 -> "DigitalZoomRatio"
323
+
| 0xA405 -> "FocalLengthIn35mmFilm"
324
+
| 0xA406 -> "SceneCaptureType"
325
+
| 0xA407 -> "GainControl"
326
+
| 0xA408 -> "Contrast"
327
+
| 0xA409 -> "Saturation"
328
+
| 0xA40A -> "Sharpness"
329
+
| 0xA40C -> "SubjectDistanceRange"
330
+
| 0xA420 -> "ImageUniqueID"
331
+
| 0xA430 -> "CameraOwnerName"
332
+
| 0xA431 -> "BodySerialNumber"
333
+
| 0xA432 -> "LensSpecification"
334
+
| 0xA433 -> "LensMake"
335
+
| 0xA434 -> "LensModel"
336
+
| 0xA435 -> "LensSerialNumber"
337
+
| 0xA500 -> "Gamma"
338
+
| _ -> Printf.sprintf "Tag_0x%04X" tag)
339
+
end
340
+
341
+
(** {1 Parsing} *)
342
+
343
+
exception Parse_error of string
344
+
345
+
let format_size = function
346
+
| Byte | Ascii | Sbyte | Undefined -> 1
347
+
| Short | Sshort -> 2
348
+
| Long | Slong | Float -> 4
349
+
| Rational | Srational | Double -> 8
350
+
351
+
let format_of_int = function
352
+
| 1 -> Byte
353
+
| 2 -> Ascii
354
+
| 3 -> Short
355
+
| 4 -> Long
356
+
| 5 -> Rational
357
+
| 6 -> Sbyte
358
+
| 7 -> Undefined
359
+
| 8 -> Sshort
360
+
| 9 -> Slong
361
+
| 10 -> Srational
362
+
| 11 -> Float
363
+
| 12 -> Double
364
+
| n -> raise (Parse_error (Printf.sprintf "Unknown format: %d" n))
365
+
366
+
(** Read 16-bit value with given byte order *)
367
+
let read_u16 data offset byte_order =
368
+
let b0 = Bytes.get_uint8 data offset in
369
+
let b1 = Bytes.get_uint8 data (offset + 1) in
370
+
match byte_order with
371
+
| Big_endian -> (b0 lsl 8) lor b1
372
+
| Little_endian -> (b1 lsl 8) lor b0
373
+
374
+
(** Read 32-bit value with given byte order *)
375
+
let read_u32 data offset byte_order =
376
+
let b0 = Int32.of_int (Bytes.get_uint8 data offset) in
377
+
let b1 = Int32.of_int (Bytes.get_uint8 data (offset + 1)) in
378
+
let b2 = Int32.of_int (Bytes.get_uint8 data (offset + 2)) in
379
+
let b3 = Int32.of_int (Bytes.get_uint8 data (offset + 3)) in
380
+
match byte_order with
381
+
| Big_endian ->
382
+
Int32.(logor (shift_left b0 24)
383
+
(logor (shift_left b1 16)
384
+
(logor (shift_left b2 8) b3)))
385
+
| Little_endian ->
386
+
Int32.(logor (shift_left b3 24)
387
+
(logor (shift_left b2 16)
388
+
(logor (shift_left b1 8) b0)))
389
+
390
+
let read_s32 = read_u32
391
+
392
+
(** Read IEEE 754 single precision float *)
393
+
let read_float data offset byte_order =
394
+
Int32.float_of_bits (read_u32 data offset byte_order)
395
+
396
+
(** Read IEEE 754 double precision float *)
397
+
let read_double data offset byte_order =
398
+
let b = Bytes.create 8 in
399
+
(match byte_order with
400
+
| Big_endian ->
401
+
for i = 0 to 7 do
402
+
Bytes.set b i (Bytes.get data (offset + i))
403
+
done
404
+
| Little_endian ->
405
+
for i = 0 to 7 do
406
+
Bytes.set b (7 - i) (Bytes.get data (offset + i))
407
+
done);
408
+
Int64.float_of_bits (Bytes.get_int64_be b 0)
409
+
410
+
(** Parse entry value from data *)
411
+
let parse_value data offset byte_order format components =
412
+
let size = format_size format * components in
413
+
if offset + size > Bytes.length data then
414
+
raise (Parse_error "Value extends beyond data");
415
+
match format with
416
+
| Byte ->
417
+
VByte (Array.init components (fun i ->
418
+
Bytes.get_uint8 data (offset + i)))
419
+
| Ascii ->
420
+
let s = Bytes.sub_string data offset components in
421
+
let len = String.length s in
422
+
let s =
423
+
if len > 0 && s.[len - 1] = '\000' then
424
+
String.sub s 0 (len - 1)
425
+
else
426
+
s
427
+
in
428
+
VAscii s
429
+
| Short ->
430
+
VShort (Array.init components (fun i ->
431
+
read_u16 data (offset + i * 2) byte_order))
432
+
| Long ->
433
+
VLong (Array.init components (fun i ->
434
+
read_u32 data (offset + i * 4) byte_order))
435
+
| Rational ->
436
+
VRational (Array.init components (fun i ->
437
+
let off = offset + i * 8 in
438
+
{ numerator = read_u32 data off byte_order;
439
+
denominator = read_u32 data (off + 4) byte_order }))
440
+
| Sbyte ->
441
+
VSbyte (Array.init components (fun i ->
442
+
let v = Bytes.get_uint8 data (offset + i) in
443
+
if v >= 128 then v - 256 else v))
444
+
| Undefined ->
445
+
VUndefined (Bytes.sub data offset components)
446
+
| Sshort ->
447
+
VSshort (Array.init components (fun i ->
448
+
let v = read_u16 data (offset + i * 2) byte_order in
449
+
if v >= 32768 then v - 65536 else v))
450
+
| Slong ->
451
+
VSlong (Array.init components (fun i ->
452
+
read_s32 data (offset + i * 4) byte_order))
453
+
| Srational ->
454
+
VSrational (Array.init components (fun i ->
455
+
let off = offset + i * 8 in
456
+
{ snumerator = read_s32 data off byte_order;
457
+
sdenominator = read_s32 data (off + 4) byte_order }))
458
+
| Float ->
459
+
VFloat (Array.init components (fun i ->
460
+
read_float data (offset + i * 4) byte_order))
461
+
| Double ->
462
+
VDouble (Array.init components (fun i ->
463
+
read_double data (offset + i * 8) byte_order))
464
+
465
+
(** Parse a single IFD entry *)
466
+
let parse_entry data offset byte_order ifd =
467
+
if offset + 12 > Bytes.length data then
468
+
raise (Parse_error "Entry extends beyond data");
469
+
let tag = read_u16 data offset byte_order in
470
+
let format_code = read_u16 data (offset + 2) byte_order in
471
+
let format = format_of_int format_code in
472
+
let components = Int32.to_int (read_u32 data (offset + 4) byte_order) in
473
+
let value_size = format_size format * components in
474
+
let value_offset =
475
+
if value_size <= 4 then
476
+
offset + 8
477
+
else
478
+
Int32.to_int (read_u32 data (offset + 8) byte_order)
479
+
in
480
+
let value = parse_value data value_offset byte_order format components in
481
+
{ tag; ifd; format; components; value }
482
+
483
+
(** Parse an IFD and return entries and next IFD offset *)
484
+
let parse_ifd data offset byte_order ifd =
485
+
if offset + 2 > Bytes.length data then
486
+
raise (Parse_error "IFD extends beyond data");
487
+
let entry_count = read_u16 data offset byte_order in
488
+
let entries_end = offset + 2 + entry_count * 12 in
489
+
if entries_end + 4 > Bytes.length data then
490
+
raise (Parse_error "IFD entries extend beyond data");
491
+
let entries =
492
+
List.init entry_count (fun i ->
493
+
parse_entry data (offset + 2 + i * 12) byte_order ifd)
494
+
in
495
+
let next_ifd_offset = Int32.to_int (read_u32 data entries_end byte_order) in
496
+
(entries, next_ifd_offset)
497
+
498
+
(** Find IFD pointer entry *)
499
+
let find_ifd_pointer entries tag =
500
+
match List.find_opt (fun e -> e.tag = tag) entries with
501
+
| Some { value = VLong [| offset |]; _ } -> Some (Int32.to_int offset)
502
+
| _ -> None
503
+
504
+
(** Parse complete EXIF data from bytes *)
505
+
let parse data =
506
+
let len = Bytes.length data in
507
+
if len < 8 then
508
+
raise (Parse_error "Data too short for EXIF header");
509
+
510
+
(* Check byte order marker *)
511
+
let byte_order =
512
+
match Bytes.get_uint8 data 0, Bytes.get_uint8 data 1 with
513
+
| 0x4D, 0x4D -> Big_endian (* "MM" - Motorola *)
514
+
| 0x49, 0x49 -> Little_endian (* "II" - Intel *)
515
+
| _ -> raise (Parse_error "Invalid byte order marker")
516
+
in
517
+
518
+
(* Check TIFF magic number (42) *)
519
+
let magic = read_u16 data 2 byte_order in
520
+
if magic <> 42 then
521
+
raise (Parse_error (Printf.sprintf "Invalid TIFF magic: %d" magic));
522
+
523
+
(* Get offset to first IFD *)
524
+
let ifd0_offset = Int32.to_int (read_u32 data 4 byte_order) in
525
+
if ifd0_offset < 8 || ifd0_offset >= len then
526
+
raise (Parse_error "Invalid IFD0 offset");
527
+
528
+
(* Parse IFD0 *)
529
+
let ifd0_entries, ifd1_offset = parse_ifd data ifd0_offset byte_order IFD0 in
530
+
531
+
(* Parse EXIF sub-IFD if present *)
532
+
let exif_entries =
533
+
find_ifd_pointer ifd0_entries Tag.exif_ifd_pointer
534
+
|> Option.fold ~none:[] ~some:(fun off ->
535
+
if off > 0 && off < len then
536
+
fst (parse_ifd data off byte_order EXIF)
537
+
else [])
538
+
in
539
+
540
+
(* Parse GPS sub-IFD if present *)
541
+
let gps_entries =
542
+
find_ifd_pointer ifd0_entries Tag.gps_info_ifd_pointer
543
+
|> Option.fold ~none:[] ~some:(fun off ->
544
+
if off > 0 && off < len then
545
+
fst (parse_ifd data off byte_order GPS)
546
+
else [])
547
+
in
548
+
549
+
(* Parse Interoperability IFD if present (pointer is in EXIF IFD) *)
550
+
let interop_entries =
551
+
find_ifd_pointer exif_entries Tag.interoperability_ifd_pointer
552
+
|> Option.fold ~none:[] ~some:(fun off ->
553
+
if off > 0 && off < len then
554
+
fst (parse_ifd data off byte_order Interoperability)
555
+
else [])
556
+
in
557
+
558
+
(* Parse IFD1 (thumbnail) if present *)
559
+
let ifd1_entries, thumbnail =
560
+
if ifd1_offset > 0 && ifd1_offset < len then
561
+
let entries, _ = parse_ifd data ifd1_offset byte_order IFD1 in
562
+
(* Look for JPEG thumbnail *)
563
+
let thumb_offset =
564
+
find_ifd_pointer entries Tag.jpeg_interchange_format
565
+
in
566
+
let thumb_length =
567
+
find_ifd_pointer entries Tag.jpeg_interchange_format_length
568
+
in
569
+
let thumbnail =
570
+
match thumb_offset, thumb_length with
571
+
| Some off, Some len when off > 0 && off + len <= Bytes.length data ->
572
+
Some (Bytes.sub data off len)
573
+
| _ -> None
574
+
in
575
+
(entries, thumbnail)
576
+
else
577
+
([], None)
578
+
in
579
+
580
+
let entries =
581
+
ifd0_entries @ ifd1_entries @ exif_entries @ gps_entries @ interop_entries
582
+
in
583
+
{ byte_order; entries; thumbnail }
584
+
585
+
let parse_from_app1 = parse
586
+
587
+
(** {1 Query functions} *)
588
+
589
+
let find_entry tag exif =
590
+
List.find_opt (fun e -> e.tag = tag) exif.entries
591
+
592
+
let find_entry_in_ifd tag ifd exif =
593
+
List.find_opt (fun e -> e.tag = tag && e.ifd = ifd) exif.entries
594
+
595
+
let entries_in_ifd ifd exif =
596
+
List.filter (fun e -> e.ifd = ifd) exif.entries
597
+
598
+
(** {1 Value extraction helpers} *)
599
+
600
+
let get_string entry =
601
+
match entry.value with
602
+
| VAscii s -> Some s
603
+
| _ -> None
604
+
605
+
let get_short entry =
606
+
match entry.value with
607
+
| VShort [| v |] -> Some v
608
+
| _ -> None
609
+
610
+
let get_long entry =
611
+
match entry.value with
612
+
| VLong [| v |] -> Some (Int32.to_int v)
613
+
| _ -> None
614
+
615
+
let get_rational entry =
616
+
match entry.value with
617
+
| VRational [| { numerator; denominator } |] ->
618
+
if denominator = 0l then None
619
+
else Some (Int32.to_float numerator /. Int32.to_float denominator)
620
+
| _ -> None
621
+
622
+
let get_rationals entry =
623
+
match entry.value with
624
+
| VRational arr ->
625
+
Some (Array.map (fun { numerator; denominator } ->
626
+
if denominator = 0l then 0.0
627
+
else Int32.to_float numerator /. Int32.to_float denominator) arr)
628
+
| _ -> None
629
+
630
+
(** {1 Common metadata accessors} *)
631
+
632
+
let make exif =
633
+
Option.bind (find_entry Tag.make exif) get_string
634
+
635
+
let model exif =
636
+
Option.bind (find_entry Tag.model exif) get_string
637
+
638
+
let software exif =
639
+
Option.bind (find_entry Tag.software exif) get_string
640
+
641
+
let image_description exif =
642
+
Option.bind (find_entry Tag.image_description exif) get_string
643
+
644
+
let artist exif =
645
+
Option.bind (find_entry Tag.artist exif) get_string
646
+
647
+
let copyright exif =
648
+
Option.bind (find_entry Tag.copyright exif) get_string
649
+
650
+
let date_time_original exif =
651
+
Option.bind (find_entry Tag.date_time_original exif) get_string
652
+
653
+
let date_time_digitized exif =
654
+
Option.bind (find_entry Tag.date_time_digitized exif) get_string
655
+
656
+
let date_time exif =
657
+
Option.bind (find_entry Tag.date_time exif) get_string
658
+
659
+
let orientation exif =
660
+
Option.bind (find_entry Tag.orientation exif) get_short
661
+
662
+
let image_width exif =
663
+
Option.bind (find_entry Tag.image_width exif) (fun e ->
664
+
match e.value with
665
+
| VShort [| v |] -> Some v
666
+
| VLong [| v |] -> Some (Int32.to_int v)
667
+
| _ -> None)
668
+
669
+
let image_height exif =
670
+
Option.bind (find_entry Tag.image_length exif) (fun e ->
671
+
match e.value with
672
+
| VShort [| v |] -> Some v
673
+
| VLong [| v |] -> Some (Int32.to_int v)
674
+
| _ -> None)
675
+
676
+
let x_resolution exif =
677
+
Option.bind (find_entry Tag.x_resolution exif) get_rational
678
+
679
+
let y_resolution exif =
680
+
Option.bind (find_entry Tag.y_resolution exif) get_rational
681
+
682
+
let resolution_unit exif =
683
+
Option.bind (find_entry Tag.resolution_unit exif) get_short
684
+
685
+
let exposure_time exif =
686
+
Option.bind (find_entry Tag.exposure_time exif) get_rational
687
+
688
+
let f_number exif =
689
+
Option.bind (find_entry Tag.f_number exif) get_rational
690
+
691
+
let iso_speed exif =
692
+
Option.bind (find_entry Tag.iso_speed_ratings exif) (fun e ->
693
+
match e.value with
694
+
| VShort [| v |] -> Some v
695
+
| VShort arr when Array.length arr > 0 -> Some arr.(0)
696
+
| _ -> None)
697
+
698
+
let focal_length exif =
699
+
Option.bind (find_entry Tag.focal_length exif) get_rational
700
+
701
+
let focal_length_35mm exif =
702
+
Option.bind (find_entry Tag.focal_length_in_35mm_film exif) get_short
703
+
704
+
let flash exif =
705
+
Option.bind (find_entry Tag.flash exif) get_short
706
+
707
+
let color_space exif =
708
+
Option.bind (find_entry Tag.color_space exif) get_short
709
+
710
+
let exif_version exif =
711
+
Option.bind (find_entry Tag.exif_version exif) (fun e ->
712
+
match e.value with
713
+
| VUndefined b -> Some (Bytes.to_string b)
714
+
| _ -> None)
715
+
716
+
(** {1 GPS accessors} *)
717
+
718
+
(** Convert DMS (degrees/minutes/seconds) rationals to decimal degrees *)
719
+
let dms_to_decimal rationals =
720
+
if Array.length rationals < 3 then
721
+
None
722
+
else
723
+
let degrees =
724
+
Int32.to_float rationals.(0).numerator /.
725
+
Int32.to_float rationals.(0).denominator
726
+
in
727
+
let minutes =
728
+
Int32.to_float rationals.(1).numerator /.
729
+
Int32.to_float rationals.(1).denominator
730
+
in
731
+
let seconds =
732
+
Int32.to_float rationals.(2).numerator /.
733
+
Int32.to_float rationals.(2).denominator
734
+
in
735
+
Some (degrees +. minutes /. 60.0 +. seconds /. 3600.0)
736
+
737
+
let gps_latitude exif =
738
+
Option.bind (find_entry_in_ifd Tag.gps_latitude GPS exif) (fun e ->
739
+
match e.value with
740
+
| VRational arr ->
741
+
Option.map (fun lat ->
742
+
match find_entry_in_ifd Tag.gps_latitude_ref GPS exif with
743
+
| Some { value = VAscii "S"; _ } -> -.lat
744
+
| _ -> lat)
745
+
(dms_to_decimal arr)
746
+
| _ -> None)
747
+
748
+
let gps_longitude exif =
749
+
Option.bind (find_entry_in_ifd Tag.gps_longitude GPS exif) (fun e ->
750
+
match e.value with
751
+
| VRational arr ->
752
+
Option.map (fun lon ->
753
+
match find_entry_in_ifd Tag.gps_longitude_ref GPS exif with
754
+
| Some { value = VAscii "W"; _ } -> -.lon
755
+
| _ -> lon)
756
+
(dms_to_decimal arr)
757
+
| _ -> None)
758
+
759
+
let gps_altitude exif =
760
+
Option.map (fun alt ->
761
+
match find_entry_in_ifd Tag.gps_altitude_ref GPS exif with
762
+
| Some { value = VByte [| 1 |]; _ } -> -.alt
763
+
| _ -> alt)
764
+
(Option.bind (find_entry_in_ifd Tag.gps_altitude GPS exif) get_rational)
765
+
766
+
(** {1 Pretty printing} *)
767
+
768
+
let string_of_value = function
769
+
| VByte arr ->
770
+
arr |> Array.to_list |> List.map string_of_int |> String.concat " "
771
+
| VAscii s -> s
772
+
| VShort arr ->
773
+
arr |> Array.to_list |> List.map string_of_int |> String.concat " "
774
+
| VLong arr ->
775
+
arr |> Array.to_list |> List.map Int32.to_string |> String.concat " "
776
+
| VRational arr ->
777
+
arr
778
+
|> Array.to_list
779
+
|> List.map (fun r -> Printf.sprintf "%ld/%ld" r.numerator r.denominator)
780
+
|> String.concat " "
781
+
| VSbyte arr ->
782
+
arr |> Array.to_list |> List.map string_of_int |> String.concat " "
783
+
| VUndefined b ->
784
+
if Bytes.length b <= 16 then
785
+
List.init (Bytes.length b) (fun i ->
786
+
Printf.sprintf "%02X" (Bytes.get_uint8 b i))
787
+
|> String.concat " "
788
+
else
789
+
Printf.sprintf "<%d bytes>" (Bytes.length b)
790
+
| VSshort arr ->
791
+
arr |> Array.to_list |> List.map string_of_int |> String.concat " "
792
+
| VSlong arr ->
793
+
arr |> Array.to_list |> List.map Int32.to_string |> String.concat " "
794
+
| VSrational arr ->
795
+
arr
796
+
|> Array.to_list
797
+
|> List.map (fun r ->
798
+
Printf.sprintf "%ld/%ld" r.snumerator r.sdenominator)
799
+
|> String.concat " "
800
+
| VFloat arr ->
801
+
arr |> Array.to_list |> List.map string_of_float |> String.concat " "
802
+
| VDouble arr ->
803
+
arr |> Array.to_list |> List.map string_of_float |> String.concat " "
804
+
805
+
let string_of_entry entry =
806
+
Printf.sprintf "%s: %s"
807
+
(Tag.name_of_tag entry.tag entry.ifd)
808
+
(string_of_value entry.value)
809
+
810
+
let string_of_ifd = function
811
+
| IFD0 -> "IFD0"
812
+
| IFD1 -> "IFD1"
813
+
| EXIF -> "EXIF"
814
+
| GPS -> "GPS"
815
+
| Interoperability -> "Interoperability"
816
+
817
+
let to_string exif =
818
+
exif.entries
819
+
|> List.map (fun entry ->
820
+
Printf.sprintf "[%s] %s" (string_of_ifd entry.ifd) (string_of_entry entry))
821
+
|> String.concat "\n"
+639
project/ocaml-exif/src/exif.mli
+639
project/ocaml-exif/src/exif.mli
···
1
+
(** {1 OCaml EXIF Library}
2
+
3
+
A pure OCaml implementation of EXIF (Exchangeable Image File Format)
4
+
metadata parsing, based on the {{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
5
+
EXIF 2.32 Specification} and {{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
6
+
TIFF 6.0 Specification}.
7
+
8
+
{2 Overview}
9
+
10
+
EXIF data is embedded in JPEG, TIFF, and other image formats to store
11
+
metadata about the image, including:
12
+
13
+
- Camera make and model
14
+
- Date and time the image was captured
15
+
- Exposure settings (shutter speed, aperture, ISO)
16
+
- GPS coordinates
17
+
- Orientation information
18
+
- Thumbnail image
19
+
20
+
{2 EXIF Structure}
21
+
22
+
EXIF data follows the TIFF file format structure:
23
+
24
+
{v
25
+
+-------------------------------------------+
26
+
| TIFF Header (8 bytes) |
27
+
| Byte order (II=Intel, MM=Motorola) |
28
+
| Magic number (42) |
29
+
| Offset to IFD0 |
30
+
+-------------------------------------------+
31
+
| IFD0 (Primary Image) |
32
+
| - Image dimensions |
33
+
| - Make, Model, Software |
34
+
| - DateTime |
35
+
| - Pointer to EXIF IFD |
36
+
| - Pointer to GPS IFD |
37
+
+-------------------------------------------+
38
+
| EXIF IFD (Camera Settings) |
39
+
| - ExposureTime, FNumber, ISO |
40
+
| - DateTimeOriginal |
41
+
| - FocalLength, Flash |
42
+
+-------------------------------------------+
43
+
| GPS IFD (Location Data) |
44
+
| - Latitude, Longitude, Altitude |
45
+
| - Timestamp, DateStamp |
46
+
+-------------------------------------------+
47
+
| IFD1 (Thumbnail Image) |
48
+
| - Thumbnail dimensions |
49
+
| - JPEG thumbnail data |
50
+
+-------------------------------------------+
51
+
v}
52
+
53
+
{2 Quick Start}
54
+
55
+
{[
56
+
(* Parse EXIF from raw APP1 data *)
57
+
let exif = Exif.parse_from_app1 app1_data in
58
+
59
+
(* Get camera make and model *)
60
+
let make = Exif.make exif in
61
+
let model = Exif.model exif in
62
+
63
+
(* Get GPS coordinates *)
64
+
match Exif.gps_latitude exif, Exif.gps_longitude exif with
65
+
| Some lat, Some lon ->
66
+
Printf.printf "Location: %f, %f\n" lat lon
67
+
| _ -> ()
68
+
69
+
(* Dump all EXIF tags *)
70
+
print_endline (Exif.to_string exif)
71
+
]}
72
+
73
+
{2 References}
74
+
75
+
- {{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
76
+
EXIF 2.32 Specification (CIPA DC-008-Translation-2019)}
77
+
- {{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
78
+
TIFF 6.0 Specification}
79
+
- {{:https://exiftool.org/TagNames/EXIF.html} ExifTool Tag Reference} *)
80
+
81
+
(** {1 Types} *)
82
+
83
+
(** {2 Byte Order}
84
+
85
+
TIFF/EXIF data can be stored in either byte order, indicated by
86
+
the first two bytes of the TIFF header.
87
+
88
+
{{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
89
+
TIFF 6.0 Section 2: Structure of a TIFF File} *)
90
+
91
+
type byte_order =
92
+
| Big_endian
93
+
(** "MM" (0x4D4D) - Motorola byte order, most significant byte first *)
94
+
| Little_endian
95
+
(** "II" (0x4949) - Intel byte order, least significant byte first *)
96
+
97
+
(** {2 Data Formats}
98
+
99
+
EXIF inherits TIFF's data type system. Each IFD entry specifies a format
100
+
code indicating how to interpret the value bytes.
101
+
102
+
{{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
103
+
TIFF 6.0 Section 2: TIFF Field Types} *)
104
+
105
+
type format =
106
+
| Byte (** Type 1: 8-bit unsigned integer (1 byte) *)
107
+
| Ascii (** Type 2: 8-bit byte containing 7-bit ASCII, NUL-terminated *)
108
+
| Short (** Type 3: 16-bit unsigned integer (2 bytes) *)
109
+
| Long (** Type 4: 32-bit unsigned integer (4 bytes) *)
110
+
| Rational (** Type 5: Two LONGs - numerator and denominator (8 bytes) *)
111
+
| Sbyte (** Type 6: 8-bit signed integer (1 byte) *)
112
+
| Undefined (** Type 7: 8-bit byte, application-defined meaning *)
113
+
| Sshort (** Type 8: 16-bit signed integer (2 bytes) *)
114
+
| Slong (** Type 9: 32-bit signed integer (4 bytes) *)
115
+
| Srational (** Type 10: Two SLONGs - signed numerator/denominator (8 bytes) *)
116
+
| Float (** Type 11: IEEE 754 single precision (4 bytes) *)
117
+
| Double (** Type 12: IEEE 754 double precision (8 bytes) *)
118
+
119
+
(** {2 Image File Directories (IFDs)}
120
+
121
+
EXIF data is organized into multiple IFDs, each containing related tags.
122
+
123
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
124
+
EXIF 2.32 Section 4.6: IFD Structure} *)
125
+
126
+
type ifd =
127
+
| IFD0
128
+
(** Primary image IFD - contains basic image info and pointers to
129
+
sub-IFDs. {{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
130
+
TIFF 6.0 Section 2} *)
131
+
| IFD1
132
+
(** Thumbnail image IFD - contains thumbnail image info.
133
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
134
+
EXIF 2.32 Section 4.5.4} *)
135
+
| EXIF
136
+
(** EXIF private IFD - contains camera exposure data.
137
+
Pointed to by tag 0x8769 (ExifIFDPointer) in IFD0.
138
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
139
+
EXIF 2.32 Section 4.6.3} *)
140
+
| GPS
141
+
(** GPS info IFD - contains geolocation data.
142
+
Pointed to by tag 0x8825 (GPSInfoIFDPointer) in IFD0.
143
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
144
+
EXIF 2.32 Section 4.6.6} *)
145
+
| Interoperability
146
+
(** Interoperability IFD - contains compatibility info.
147
+
Pointed to by tag 0xA005 in EXIF IFD.
148
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
149
+
EXIF 2.32 Section 4.6.4} *)
150
+
151
+
(** {2 Rational Numbers}
152
+
153
+
EXIF uses rational numbers (numerator/denominator pairs) for
154
+
precise representation of values like exposure time and GPS coordinates. *)
155
+
156
+
(** Unsigned rational number (two 32-bit unsigned integers).
157
+
{{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
158
+
TIFF Type 5} *)
159
+
type rational = {
160
+
numerator : int32;
161
+
denominator : int32;
162
+
}
163
+
164
+
(** Signed rational number (two 32-bit signed integers).
165
+
{{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
166
+
TIFF Type 10} *)
167
+
type srational = {
168
+
snumerator : int32;
169
+
sdenominator : int32;
170
+
}
171
+
172
+
(** {2 Tag Values}
173
+
174
+
Typed representation of EXIF tag values. The variant corresponds
175
+
to the format type of the IFD entry. *)
176
+
177
+
type value =
178
+
| VByte of int array
179
+
| VAscii of string
180
+
| VShort of int array
181
+
| VLong of int32 array
182
+
| VRational of rational array
183
+
| VSbyte of int array
184
+
| VUndefined of bytes
185
+
| VSshort of int array
186
+
| VSlong of int32 array
187
+
| VSrational of srational array
188
+
| VFloat of float array
189
+
| VDouble of float array
190
+
191
+
(** {2 EXIF Entry}
192
+
193
+
A single tag entry from an IFD.
194
+
195
+
{{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
196
+
TIFF 6.0 Section 2: IFD Entry} *)
197
+
198
+
type entry = {
199
+
tag : int;
200
+
(** Tag number identifying this field (e.g., 0x010F for Make) *)
201
+
ifd : ifd;
202
+
(** Which IFD this entry belongs to *)
203
+
format : format;
204
+
(** Data type of the value *)
205
+
components : int;
206
+
(** Number of values (array length) *)
207
+
value : value;
208
+
(** The actual value(s) *)
209
+
}
210
+
211
+
(** {2 Complete EXIF Data}
212
+
213
+
Parsed EXIF metadata container. *)
214
+
215
+
type t = {
216
+
byte_order : byte_order;
217
+
(** Byte order used in the original data *)
218
+
entries : entry list;
219
+
(** All parsed IFD entries *)
220
+
thumbnail : bytes option;
221
+
(** Embedded JPEG thumbnail image, if present *)
222
+
}
223
+
224
+
(** {1 Tag Constants}
225
+
226
+
Standard EXIF tag numbers organized by IFD.
227
+
228
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
229
+
EXIF 2.32 Section 4.6.4-4.6.8: Tag Tables} *)
230
+
231
+
module Tag : sig
232
+
(** {2 TIFF/IFD0 Tags}
233
+
234
+
Basic image information tags from TIFF specification.
235
+
{{:https://www.itu.int/itudoc/itu-t/com16/tiff-fx/docs/tiff6.pdf}
236
+
TIFF 6.0 Section 8: Baseline TIFF Tags}
237
+
238
+
- [image_width] (0x0100): Image width in pixels
239
+
- [image_length] (0x0101): Image height in pixels
240
+
- [bits_per_sample] (0x0102): Bits per component
241
+
- [compression] (0x0103): Compression scheme
242
+
- [photometric_interpretation] (0x0106): Color space
243
+
- [image_description] (0x010E): Image title
244
+
- [make] (0x010F): Camera manufacturer
245
+
- [model] (0x0110): Camera model
246
+
- [orientation] (0x0112): Image orientation (1-8)
247
+
- [x_resolution] (0x011A): Horizontal resolution
248
+
- [y_resolution] (0x011B): Vertical resolution
249
+
- [resolution_unit] (0x0128): Resolution unit
250
+
- [software] (0x0131): Software used
251
+
- [date_time] (0x0132): File modification date
252
+
- [artist] (0x013B): Image creator
253
+
- [copyright] (0x8298): Copyright notice *)
254
+
255
+
val image_width : int
256
+
val image_length : int
257
+
val bits_per_sample : int
258
+
val compression : int
259
+
val photometric_interpretation : int
260
+
val image_description : int
261
+
val make : int
262
+
val model : int
263
+
val strip_offsets : int
264
+
val orientation : int
265
+
val samples_per_pixel : int
266
+
val rows_per_strip : int
267
+
val strip_byte_counts : int
268
+
val x_resolution : int
269
+
val y_resolution : int
270
+
val planar_configuration : int
271
+
val resolution_unit : int
272
+
val transfer_function : int
273
+
val software : int
274
+
val date_time : int
275
+
val artist : int
276
+
val white_point : int
277
+
val primary_chromaticities : int
278
+
val jpeg_interchange_format : int
279
+
val jpeg_interchange_format_length : int
280
+
val ycbcr_coefficients : int
281
+
val ycbcr_sub_sampling : int
282
+
val ycbcr_positioning : int
283
+
val reference_black_white : int
284
+
val copyright : int
285
+
val exif_ifd_pointer : int
286
+
val gps_info_ifd_pointer : int
287
+
288
+
(** {2 EXIF IFD Tags}
289
+
290
+
Camera and exposure settings.
291
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
292
+
EXIF 2.32 Section 4.6.5: EXIF IFD Tags}
293
+
294
+
- [exposure_time] (0x829A): Exposure time in seconds
295
+
- [f_number] (0x829D): F-number (aperture)
296
+
- [iso_speed_ratings] (0x8827): ISO speed
297
+
- [exif_version] (0x9000): EXIF version
298
+
- [date_time_original] (0x9003): When photo was taken
299
+
- [date_time_digitized] (0x9004): When digitized
300
+
- [shutter_speed_value] (0x9201): Shutter speed (APEX)
301
+
- [aperture_value] (0x9202): Aperture (APEX)
302
+
- [focal_length] (0x920A): Focal length in mm
303
+
- [flash] (0x9209): Flash status
304
+
- [color_space] (0xA001): Color space (1=sRGB)
305
+
- [focal_length_in_35mm_film] (0xA405): 35mm equivalent *)
306
+
307
+
val exposure_time : int
308
+
val f_number : int
309
+
val exposure_program : int
310
+
val spectral_sensitivity : int
311
+
val iso_speed_ratings : int
312
+
val oecf : int
313
+
val sensitivity_type : int
314
+
val exif_version : int
315
+
val date_time_original : int
316
+
val date_time_digitized : int
317
+
val offset_time : int
318
+
val offset_time_original : int
319
+
val offset_time_digitized : int
320
+
val components_configuration : int
321
+
val compressed_bits_per_pixel : int
322
+
val shutter_speed_value : int
323
+
val aperture_value : int
324
+
val brightness_value : int
325
+
val exposure_bias_value : int
326
+
val max_aperture_value : int
327
+
val subject_distance : int
328
+
val metering_mode : int
329
+
val light_source : int
330
+
val flash : int
331
+
val focal_length : int
332
+
val subject_area : int
333
+
val maker_note : int
334
+
val user_comment : int
335
+
val sub_sec_time : int
336
+
val sub_sec_time_original : int
337
+
val sub_sec_time_digitized : int
338
+
val flash_pix_version : int
339
+
val color_space : int
340
+
val pixel_x_dimension : int
341
+
val pixel_y_dimension : int
342
+
val related_sound_file : int
343
+
val interoperability_ifd_pointer : int
344
+
val flash_energy : int
345
+
val spatial_frequency_response : int
346
+
val focal_plane_x_resolution : int
347
+
val focal_plane_y_resolution : int
348
+
val focal_plane_resolution_unit : int
349
+
val subject_location : int
350
+
val exposure_index : int
351
+
val sensing_method : int
352
+
val file_source : int
353
+
val scene_type : int
354
+
val cfa_pattern : int
355
+
val custom_rendered : int
356
+
val exposure_mode : int
357
+
val white_balance : int
358
+
val digital_zoom_ratio : int
359
+
val focal_length_in_35mm_film : int
360
+
val scene_capture_type : int
361
+
val gain_control : int
362
+
val contrast : int
363
+
val saturation : int
364
+
val sharpness : int
365
+
val device_setting_description : int
366
+
val subject_distance_range : int
367
+
val image_unique_id : int
368
+
val camera_owner_name : int
369
+
val body_serial_number : int
370
+
val lens_specification : int
371
+
val lens_make : int
372
+
val lens_model : int
373
+
val lens_serial_number : int
374
+
val gamma : int
375
+
376
+
(** {2 GPS IFD Tags}
377
+
378
+
Geolocation information.
379
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
380
+
EXIF 2.32 Section 4.6.6: GPS IFD Tags}
381
+
382
+
- [gps_latitude_ref] (0x0001): "N" or "S"
383
+
- [gps_latitude] (0x0002): Latitude in DMS
384
+
- [gps_longitude_ref] (0x0003): "E" or "W"
385
+
- [gps_longitude] (0x0004): Longitude in DMS
386
+
- [gps_altitude_ref] (0x0005): 0=above, 1=below sea level
387
+
- [gps_altitude] (0x0006): Altitude in meters
388
+
- [gps_time_stamp] (0x0007): GPS time (UTC)
389
+
- [gps_date_stamp] (0x001D): GPS date *)
390
+
391
+
val gps_version_id : int
392
+
val gps_latitude_ref : int
393
+
val gps_latitude : int
394
+
val gps_longitude_ref : int
395
+
val gps_longitude : int
396
+
val gps_altitude_ref : int
397
+
val gps_altitude : int
398
+
val gps_time_stamp : int
399
+
val gps_satellites : int
400
+
val gps_status : int
401
+
val gps_measure_mode : int
402
+
val gps_dop : int
403
+
val gps_speed_ref : int
404
+
val gps_speed : int
405
+
val gps_track_ref : int
406
+
val gps_track : int
407
+
val gps_img_direction_ref : int
408
+
val gps_img_direction : int
409
+
val gps_map_datum : int
410
+
val gps_dest_latitude_ref : int
411
+
val gps_dest_latitude : int
412
+
val gps_dest_longitude_ref : int
413
+
val gps_dest_longitude : int
414
+
val gps_dest_bearing_ref : int
415
+
val gps_dest_bearing : int
416
+
val gps_dest_distance_ref : int
417
+
val gps_dest_distance : int
418
+
val gps_processing_method : int
419
+
val gps_area_information : int
420
+
val gps_date_stamp : int
421
+
val gps_differential : int
422
+
val gps_h_positioning_error : int
423
+
424
+
(** {2 Tag Name Lookup} *)
425
+
426
+
val name_of_tag : int -> ifd -> string
427
+
(** Get human-readable name for a tag.
428
+
429
+
@param tag Tag number
430
+
@param ifd IFD containing the tag
431
+
@return Tag name (e.g., "Make", "ExposureTime", "GPSLatitude") *)
432
+
end
433
+
434
+
(** {1 Parsing} *)
435
+
436
+
exception Parse_error of string
437
+
(** Parse error with description. *)
438
+
439
+
val parse : bytes -> t
440
+
(** Parse complete EXIF data from raw TIFF-format bytes.
441
+
442
+
The input should start with the TIFF header ("II" or "MM" byte order
443
+
marker, magic number 42, and IFD0 offset).
444
+
445
+
@raise Parse_error if the data is malformed *)
446
+
447
+
val parse_from_app1 : bytes -> t
448
+
(** Parse EXIF data from a JPEG APP1 segment.
449
+
450
+
The APP1 marker in JPEG files contains EXIF data prefixed with
451
+
"Exif\x00\x00". This function expects the data {i after} that
452
+
prefix has been stripped.
453
+
454
+
@raise Parse_error if the data is malformed *)
455
+
456
+
(** {1 Query Functions}
457
+
458
+
Functions to find and extract tag entries. *)
459
+
460
+
val find_entry : int -> t -> entry option
461
+
(** Find an entry by tag number, searching all IFDs. *)
462
+
463
+
val find_entry_in_ifd : int -> ifd -> t -> entry option
464
+
(** Find an entry by tag number in a specific IFD. *)
465
+
466
+
val entries_in_ifd : ifd -> t -> entry list
467
+
(** Get all entries belonging to a specific IFD. *)
468
+
469
+
(** {1 Value Extraction Helpers}
470
+
471
+
Convenience functions to extract typed values from entries. *)
472
+
473
+
val get_string : entry -> string option
474
+
(** Get ASCII string value. *)
475
+
476
+
val get_short : entry -> int option
477
+
(** Get single SHORT (16-bit unsigned) value. *)
478
+
479
+
val get_long : entry -> int option
480
+
(** Get single LONG (32-bit unsigned) value. *)
481
+
482
+
val get_rational : entry -> float option
483
+
(** Get single RATIONAL value as a float. *)
484
+
485
+
val get_rationals : entry -> float array option
486
+
(** Get array of RATIONAL values as floats. *)
487
+
488
+
(** {1 Common Metadata Accessors}
489
+
490
+
High-level functions to retrieve common EXIF fields.
491
+
These search the appropriate IFDs and extract values. *)
492
+
493
+
(** {2 Camera Information} *)
494
+
495
+
val make : t -> string option
496
+
(** Camera manufacturer (tag 0x010F in IFD0). *)
497
+
498
+
val model : t -> string option
499
+
(** Camera model name (tag 0x0110 in IFD0). *)
500
+
501
+
val software : t -> string option
502
+
(** Software used to create/modify the image (tag 0x0131 in IFD0). *)
503
+
504
+
val image_description : t -> string option
505
+
(** Image title or description (tag 0x010E in IFD0). *)
506
+
507
+
val artist : t -> string option
508
+
(** Creator/photographer name (tag 0x013B in IFD0). *)
509
+
510
+
val copyright : t -> string option
511
+
(** Copyright notice (tag 0x8298 in IFD0). *)
512
+
513
+
(** {2 Date and Time} *)
514
+
515
+
val date_time_original : t -> string option
516
+
(** Date/time when the original image was created (tag 0x9003 in EXIF IFD).
517
+
Format: "YYYY:MM:DD HH:MM:SS" *)
518
+
519
+
val date_time_digitized : t -> string option
520
+
(** Date/time when the image was digitized (tag 0x9004 in EXIF IFD). *)
521
+
522
+
val date_time : t -> string option
523
+
(** Date/time when the file was last modified (tag 0x0132 in IFD0). *)
524
+
525
+
(** {2 Image Properties} *)
526
+
527
+
val orientation : t -> int option
528
+
(** Image orientation (tag 0x0112 in IFD0).
529
+
530
+
Values 1-8 indicate rotation and mirroring:
531
+
- 1: Normal (no rotation)
532
+
- 2: Flipped horizontally
533
+
- 3: Rotated 180 degrees
534
+
- 4: Flipped vertically
535
+
- 5: Rotated 90 CCW, then flipped horizontally
536
+
- 6: Rotated 90 CW
537
+
- 7: Rotated 90 CW, then flipped horizontally
538
+
- 8: Rotated 90 CCW *)
539
+
540
+
val image_width : t -> int option
541
+
(** Image width from EXIF (may differ from actual image size). *)
542
+
543
+
val image_height : t -> int option
544
+
(** Image height from EXIF (may differ from actual image size). *)
545
+
546
+
val x_resolution : t -> float option
547
+
(** Horizontal resolution (tag 0x011A in IFD0). *)
548
+
549
+
val y_resolution : t -> float option
550
+
(** Vertical resolution (tag 0x011B in IFD0). *)
551
+
552
+
val resolution_unit : t -> int option
553
+
(** Resolution unit (tag 0x0128 in IFD0).
554
+
- 1: No unit (aspect ratio only)
555
+
- 2: Dots per inch
556
+
- 3: Dots per centimeter *)
557
+
558
+
(** {2 Exposure Settings} *)
559
+
560
+
val exposure_time : t -> float option
561
+
(** Exposure time in seconds (tag 0x829A in EXIF IFD).
562
+
Example: 0.001 = 1/1000 second *)
563
+
564
+
val f_number : t -> float option
565
+
(** F-number (aperture) (tag 0x829D in EXIF IFD).
566
+
Example: 2.8 = f/2.8 *)
567
+
568
+
val iso_speed : t -> int option
569
+
(** ISO speed rating (tag 0x8827 in EXIF IFD). *)
570
+
571
+
val focal_length : t -> float option
572
+
(** Focal length in millimeters (tag 0x920A in EXIF IFD). *)
573
+
574
+
val focal_length_35mm : t -> int option
575
+
(** 35mm equivalent focal length (tag 0xA405 in EXIF IFD). *)
576
+
577
+
val flash : t -> int option
578
+
(** Flash status (tag 0x9209 in EXIF IFD).
579
+
580
+
Bit field:
581
+
- Bit 0: Flash fired
582
+
- Bits 1-2: Flash return status
583
+
- Bits 3-4: Flash mode
584
+
- Bit 5: Flash function present
585
+
- Bit 6: Red-eye reduction *)
586
+
587
+
(** {2 Color Information} *)
588
+
589
+
val color_space : t -> int option
590
+
(** Color space (tag 0xA001 in EXIF IFD).
591
+
- 1: sRGB
592
+
- 65535: Uncalibrated *)
593
+
594
+
val exif_version : t -> string option
595
+
(** EXIF version string (tag 0x9000 in EXIF IFD).
596
+
Example: "0232" for EXIF 2.32 *)
597
+
598
+
(** {1 GPS Accessors}
599
+
600
+
Functions to extract GPS/geolocation data from the GPS IFD.
601
+
602
+
GPS coordinates are stored as three RATIONAL values representing
603
+
degrees, minutes, and seconds (DMS format). These functions convert
604
+
to decimal degrees for easier use. *)
605
+
606
+
val gps_latitude : t -> float option
607
+
(** GPS latitude in decimal degrees.
608
+
Positive values indicate North, negative values indicate South. *)
609
+
610
+
val gps_longitude : t -> float option
611
+
(** GPS longitude in decimal degrees.
612
+
Positive values indicate East, negative values indicate West. *)
613
+
614
+
val gps_altitude : t -> float option
615
+
(** GPS altitude in meters.
616
+
Positive values indicate above sea level, negative below. *)
617
+
618
+
(** {1 Pretty Printing}
619
+
620
+
Functions for converting EXIF data to human-readable strings. *)
621
+
622
+
val string_of_value : value -> string
623
+
(** Convert a value to a display string.
624
+
625
+
- Arrays are space-separated
626
+
- Rationals are shown as "num/denom"
627
+
- Long byte arrays show "<N bytes>" *)
628
+
629
+
val string_of_entry : entry -> string
630
+
(** Convert an entry to a human-readable string.
631
+
Format: "TagName: value" *)
632
+
633
+
val string_of_ifd : ifd -> string
634
+
(** Convert IFD type to string (e.g., "IFD0", "EXIF", "GPS"). *)
635
+
636
+
val to_string : t -> string
637
+
(** Dump all EXIF data to a multi-line string.
638
+
Each entry is shown on its own line in the format:
639
+
"[IFD] TagName: value" *)
+87
project/ocaml-exif/src/exif_jpeg.ml
+87
project/ocaml-exif/src/exif_jpeg.ml
···
1
+
(** JPEG EXIF extraction
2
+
3
+
Extract EXIF data from JPEG files by scanning marker structure.
4
+
No full JPEG decoding required - just marker parsing. *)
5
+
6
+
(** Error type for JPEG extraction *)
7
+
type error =
8
+
| Not_a_jpeg
9
+
| Truncated
10
+
| No_exif
11
+
12
+
let string_of_error = function
13
+
| Not_a_jpeg -> "Not a JPEG file"
14
+
| Truncated -> "Truncated JPEG file"
15
+
| No_exif -> "No EXIF data found"
16
+
17
+
(** Extract raw EXIF/TIFF data from JPEG bytes.
18
+
Returns the TIFF data (after "Exif\x00\x00" prefix). *)
19
+
let extract_exif_bytes data =
20
+
let len = Bytes.length data in
21
+
if len < 2 then
22
+
Error Truncated
23
+
else if Bytes.get_uint8 data 0 <> 0xFF || Bytes.get_uint8 data 1 <> 0xD8 then
24
+
Error Not_a_jpeg
25
+
else
26
+
let rec scan_markers pos =
27
+
if pos + 2 > len then Error Truncated
28
+
else if Bytes.get_uint8 data pos <> 0xFF then Error Truncated
29
+
else
30
+
let marker = Bytes.get_uint8 data (pos + 1) in
31
+
match marker with
32
+
| 0xD9 -> Error No_exif (* EOI *)
33
+
| 0xD8 -> scan_markers (pos + 2) (* SOI *)
34
+
| 0x00 -> scan_markers (pos + 1) (* Stuffed byte *)
35
+
| m when m >= 0xD0 && m <= 0xD7 ->
36
+
scan_markers (pos + 2) (* RST markers *)
37
+
| 0xE1 -> (* APP1 *)
38
+
if pos + 4 > len then Error Truncated
39
+
else
40
+
let seg_len = Bytes.get_uint16_be data (pos + 2) in
41
+
if pos + 2 + seg_len > len then Error Truncated
42
+
else if seg_len >= 8
43
+
&& Bytes.get_uint8 data (pos + 4) = 0x45 (* E *)
44
+
&& Bytes.get_uint8 data (pos + 5) = 0x78 (* x *)
45
+
&& Bytes.get_uint8 data (pos + 6) = 0x69 (* i *)
46
+
&& Bytes.get_uint8 data (pos + 7) = 0x66 (* f *)
47
+
&& Bytes.get_uint8 data (pos + 8) = 0x00
48
+
&& Bytes.get_uint8 data (pos + 9) = 0x00 then
49
+
let tiff_start = pos + 10 in
50
+
let tiff_len = seg_len - 8 in
51
+
Ok (Bytes.sub data tiff_start tiff_len)
52
+
else
53
+
scan_markers (pos + 2 + seg_len)
54
+
| _ ->
55
+
if pos + 4 > len then Error Truncated
56
+
else
57
+
let seg_len = Bytes.get_uint16_be data (pos + 2) in
58
+
scan_markers (pos + 2 + seg_len)
59
+
in
60
+
scan_markers 2
61
+
62
+
(** Extract and parse EXIF from JPEG bytes. *)
63
+
let extract_exif data =
64
+
match extract_exif_bytes data with
65
+
| Error e -> Error e
66
+
| Ok tiff_data ->
67
+
try Ok (Exif.parse tiff_data)
68
+
with Exif.Parse_error _ ->
69
+
Error (Truncated) (* Treat parse errors as truncation *)
70
+
71
+
(** Read JPEG file and extract EXIF. *)
72
+
let from_file filename =
73
+
let ic = open_in_bin filename in
74
+
let len = in_channel_length ic in
75
+
let data = Bytes.create len in
76
+
really_input ic data 0 len;
77
+
close_in ic;
78
+
extract_exif data
79
+
80
+
(** Read JPEG file and extract raw EXIF bytes. *)
81
+
let bytes_from_file filename =
82
+
let ic = open_in_bin filename in
83
+
let len = in_channel_length ic in
84
+
let data = Bytes.create len in
85
+
really_input ic data 0 len;
86
+
close_in ic;
87
+
extract_exif_bytes data
+41
project/ocaml-exif/src/exif_jpeg.mli
+41
project/ocaml-exif/src/exif_jpeg.mli
···
1
+
(** {1 JPEG EXIF Extraction}
2
+
3
+
Extract EXIF metadata from JPEG files without full image decoding.
4
+
5
+
JPEG files store EXIF data in APP1 markers with an "Exif\x00\x00" prefix.
6
+
This module scans the marker structure to locate and extract EXIF data.
7
+
8
+
{2 Example}
9
+
10
+
{[
11
+
match Exif_jpeg.from_file "photo.jpg" with
12
+
| Ok exif ->
13
+
Printf.printf "Camera: %s\n"
14
+
(Option.value ~default:"unknown" (Exif.model exif))
15
+
| Error e ->
16
+
Printf.eprintf "Error: %s\n" (Exif_jpeg.string_of_error e)
17
+
]} *)
18
+
19
+
(** Error types for JPEG extraction. *)
20
+
type error =
21
+
| Not_a_jpeg (** File doesn't start with JPEG SOI marker *)
22
+
| Truncated (** File is truncated or malformed *)
23
+
| No_exif (** No EXIF APP1 marker found *)
24
+
25
+
val string_of_error : error -> string
26
+
(** Convert error to human-readable string. *)
27
+
28
+
val extract_exif_bytes : bytes -> (bytes, error) result
29
+
(** Extract raw EXIF/TIFF data from JPEG bytes.
30
+
31
+
Returns the TIFF-format data after the "Exif\x00\x00" prefix.
32
+
This can be passed to {!Exif.parse} for parsing. *)
33
+
34
+
val extract_exif : bytes -> (Exif.t, error) result
35
+
(** Extract and parse EXIF from JPEG bytes in one step. *)
36
+
37
+
val from_file : string -> (Exif.t, error) result
38
+
(** Read JPEG file and extract EXIF metadata. *)
39
+
40
+
val bytes_from_file : string -> (bytes, error) result
41
+
(** Read JPEG file and extract raw EXIF bytes. *)
+412
project/ocaml-exif/src/exif_pp.ml
+412
project/ocaml-exif/src/exif_pp.ml
···
1
+
(** Pretty printing for EXIF data
2
+
3
+
Comprehensive formatters for all EXIF types with human-readable
4
+
output for common tag values. *)
5
+
6
+
open Exif
7
+
8
+
(** {1 Format Printers} *)
9
+
10
+
let pp_byte_order fmt = function
11
+
| Big_endian -> Format.fprintf fmt "Big-endian (Motorola)"
12
+
| Little_endian -> Format.fprintf fmt "Little-endian (Intel)"
13
+
14
+
let pp_format fmt = function
15
+
| Byte -> Format.fprintf fmt "BYTE"
16
+
| Ascii -> Format.fprintf fmt "ASCII"
17
+
| Short -> Format.fprintf fmt "SHORT"
18
+
| Long -> Format.fprintf fmt "LONG"
19
+
| Rational -> Format.fprintf fmt "RATIONAL"
20
+
| Sbyte -> Format.fprintf fmt "SBYTE"
21
+
| Undefined -> Format.fprintf fmt "UNDEFINED"
22
+
| Sshort -> Format.fprintf fmt "SSHORT"
23
+
| Slong -> Format.fprintf fmt "SLONG"
24
+
| Srational -> Format.fprintf fmt "SRATIONAL"
25
+
| Float -> Format.fprintf fmt "FLOAT"
26
+
| Double -> Format.fprintf fmt "DOUBLE"
27
+
28
+
let pp_ifd fmt = function
29
+
| IFD0 -> Format.fprintf fmt "IFD0"
30
+
| IFD1 -> Format.fprintf fmt "IFD1 (Thumbnail)"
31
+
| EXIF -> Format.fprintf fmt "EXIF"
32
+
| GPS -> Format.fprintf fmt "GPS"
33
+
| Interoperability -> Format.fprintf fmt "Interoperability"
34
+
35
+
(** {1 Value Printers} *)
36
+
37
+
let pp_rational fmt { numerator; denominator } =
38
+
if denominator = 0l then
39
+
Format.fprintf fmt "%ld/0" numerator
40
+
else if denominator = 1l then
41
+
Format.fprintf fmt "%ld" numerator
42
+
else
43
+
let f = Int32.to_float numerator /. Int32.to_float denominator in
44
+
if Float.is_integer f then
45
+
Format.fprintf fmt "%.0f" f
46
+
else
47
+
Format.fprintf fmt "%ld/%ld (%.4g)" numerator denominator f
48
+
49
+
let pp_srational fmt { snumerator; sdenominator } =
50
+
if sdenominator = 0l then
51
+
Format.fprintf fmt "%ld/0" snumerator
52
+
else if sdenominator = 1l then
53
+
Format.fprintf fmt "%ld" snumerator
54
+
else
55
+
let f = Int32.to_float snumerator /. Int32.to_float sdenominator in
56
+
Format.fprintf fmt "%ld/%ld (%.4g)" snumerator sdenominator f
57
+
58
+
let pp_bytes_hex fmt b =
59
+
let len = Bytes.length b in
60
+
if len <= 32 then
61
+
for i = 0 to len - 1 do
62
+
if i > 0 then Format.fprintf fmt " ";
63
+
Format.fprintf fmt "%02X" (Bytes.get_uint8 b i)
64
+
done
65
+
else begin
66
+
for i = 0 to 15 do
67
+
if i > 0 then Format.fprintf fmt " ";
68
+
Format.fprintf fmt "%02X" (Bytes.get_uint8 b i)
69
+
done;
70
+
Format.fprintf fmt " ... <%d more bytes>" (len - 16)
71
+
end
72
+
73
+
let pp_value fmt = function
74
+
| VByte arr ->
75
+
if Array.length arr = 1 then
76
+
Format.fprintf fmt "%d" arr.(0)
77
+
else
78
+
Format.fprintf fmt "[%s]"
79
+
(String.concat ", " (Array.to_list (Array.map string_of_int arr)))
80
+
| VAscii s ->
81
+
Format.fprintf fmt "\"%s\"" (String.escaped s)
82
+
| VShort arr ->
83
+
if Array.length arr = 1 then
84
+
Format.fprintf fmt "%d" arr.(0)
85
+
else
86
+
Format.fprintf fmt "[%s]"
87
+
(String.concat ", " (Array.to_list (Array.map string_of_int arr)))
88
+
| VLong arr ->
89
+
if Array.length arr = 1 then
90
+
Format.fprintf fmt "%ld" arr.(0)
91
+
else
92
+
Format.fprintf fmt "[%s]"
93
+
(String.concat ", " (Array.to_list (Array.map Int32.to_string arr)))
94
+
| VRational arr ->
95
+
if Array.length arr = 1 then
96
+
pp_rational fmt arr.(0)
97
+
else begin
98
+
Format.fprintf fmt "[";
99
+
Array.iteri (fun i r ->
100
+
if i > 0 then Format.fprintf fmt ", ";
101
+
pp_rational fmt r) arr;
102
+
Format.fprintf fmt "]"
103
+
end
104
+
| VSbyte arr ->
105
+
Format.fprintf fmt "[%s]"
106
+
(String.concat ", " (Array.to_list (Array.map string_of_int arr)))
107
+
| VUndefined b ->
108
+
pp_bytes_hex fmt b
109
+
| VSshort arr ->
110
+
Format.fprintf fmt "[%s]"
111
+
(String.concat ", " (Array.to_list (Array.map string_of_int arr)))
112
+
| VSlong arr ->
113
+
Format.fprintf fmt "[%s]"
114
+
(String.concat ", " (Array.to_list (Array.map Int32.to_string arr)))
115
+
| VSrational arr ->
116
+
Format.fprintf fmt "[";
117
+
Array.iteri (fun i r ->
118
+
if i > 0 then Format.fprintf fmt ", ";
119
+
pp_srational fmt r) arr;
120
+
Format.fprintf fmt "]"
121
+
| VFloat arr ->
122
+
Format.fprintf fmt "[%s]"
123
+
(String.concat ", " (Array.to_list (Array.map
124
+
(Printf.sprintf "%.6g") arr)))
125
+
| VDouble arr ->
126
+
Format.fprintf fmt "[%s]"
127
+
(String.concat ", " (Array.to_list (Array.map
128
+
(Printf.sprintf "%.10g") arr)))
129
+
130
+
(** {1 Semantic Value Interpreters} *)
131
+
132
+
let pp_orientation fmt = function
133
+
| 1 -> Format.fprintf fmt "Normal"
134
+
| 2 -> Format.fprintf fmt "Flipped horizontally"
135
+
| 3 -> Format.fprintf fmt "Rotated 180°"
136
+
| 4 -> Format.fprintf fmt "Flipped vertically"
137
+
| 5 -> Format.fprintf fmt "Rotated 90° CCW, flipped horizontally"
138
+
| 6 -> Format.fprintf fmt "Rotated 90° CW"
139
+
| 7 -> Format.fprintf fmt "Rotated 90° CW, flipped horizontally"
140
+
| 8 -> Format.fprintf fmt "Rotated 90° CCW"
141
+
| n -> Format.fprintf fmt "Unknown (%d)" n
142
+
143
+
let pp_resolution_unit fmt = function
144
+
| 1 -> Format.fprintf fmt "None"
145
+
| 2 -> Format.fprintf fmt "inches"
146
+
| 3 -> Format.fprintf fmt "centimeters"
147
+
| n -> Format.fprintf fmt "Unknown (%d)" n
148
+
149
+
let pp_exposure_program fmt = function
150
+
| 0 -> Format.fprintf fmt "Not defined"
151
+
| 1 -> Format.fprintf fmt "Manual"
152
+
| 2 -> Format.fprintf fmt "Normal program"
153
+
| 3 -> Format.fprintf fmt "Aperture priority"
154
+
| 4 -> Format.fprintf fmt "Shutter priority"
155
+
| 5 -> Format.fprintf fmt "Creative program"
156
+
| 6 -> Format.fprintf fmt "Action program"
157
+
| 7 -> Format.fprintf fmt "Portrait mode"
158
+
| 8 -> Format.fprintf fmt "Landscape mode"
159
+
| n -> Format.fprintf fmt "Unknown (%d)" n
160
+
161
+
let pp_metering_mode fmt = function
162
+
| 0 -> Format.fprintf fmt "Unknown"
163
+
| 1 -> Format.fprintf fmt "Average"
164
+
| 2 -> Format.fprintf fmt "Center-weighted average"
165
+
| 3 -> Format.fprintf fmt "Spot"
166
+
| 4 -> Format.fprintf fmt "Multi-spot"
167
+
| 5 -> Format.fprintf fmt "Pattern"
168
+
| 6 -> Format.fprintf fmt "Partial"
169
+
| 255 -> Format.fprintf fmt "Other"
170
+
| n -> Format.fprintf fmt "Unknown (%d)" n
171
+
172
+
let pp_light_source fmt = function
173
+
| 0 -> Format.fprintf fmt "Unknown"
174
+
| 1 -> Format.fprintf fmt "Daylight"
175
+
| 2 -> Format.fprintf fmt "Fluorescent"
176
+
| 3 -> Format.fprintf fmt "Tungsten (incandescent)"
177
+
| 4 -> Format.fprintf fmt "Flash"
178
+
| 9 -> Format.fprintf fmt "Fine weather"
179
+
| 10 -> Format.fprintf fmt "Cloudy weather"
180
+
| 11 -> Format.fprintf fmt "Shade"
181
+
| 12 -> Format.fprintf fmt "Daylight fluorescent (D 5700-7100K)"
182
+
| 13 -> Format.fprintf fmt "Day white fluorescent (N 4600-5500K)"
183
+
| 14 -> Format.fprintf fmt "Cool white fluorescent (W 3800-4500K)"
184
+
| 15 -> Format.fprintf fmt "White fluorescent (WW 3200-3700K)"
185
+
| 16 -> Format.fprintf fmt "Warm white fluorescent (L 2600-3250K)"
186
+
| 17 -> Format.fprintf fmt "Standard light A"
187
+
| 18 -> Format.fprintf fmt "Standard light B"
188
+
| 19 -> Format.fprintf fmt "Standard light C"
189
+
| 20 -> Format.fprintf fmt "D55"
190
+
| 21 -> Format.fprintf fmt "D65"
191
+
| 22 -> Format.fprintf fmt "D75"
192
+
| 23 -> Format.fprintf fmt "D50"
193
+
| 24 -> Format.fprintf fmt "ISO studio tungsten"
194
+
| 255 -> Format.fprintf fmt "Other"
195
+
| n -> Format.fprintf fmt "Unknown (%d)" n
196
+
197
+
let pp_flash fmt v =
198
+
let fired = v land 1 = 1 in
199
+
let return_status = (v lsr 1) land 3 in
200
+
let mode = (v lsr 3) land 3 in
201
+
let function_present = (v lsr 5) land 1 = 0 in
202
+
let red_eye = (v lsr 6) land 1 = 1 in
203
+
Format.fprintf fmt "%s" (if fired then "Fired" else "Did not fire");
204
+
(match return_status with
205
+
| 2 -> Format.fprintf fmt ", no strobe return"
206
+
| 3 -> Format.fprintf fmt ", strobe return detected"
207
+
| _ -> ());
208
+
(match mode with
209
+
| 1 -> Format.fprintf fmt ", compulsory on"
210
+
| 2 -> Format.fprintf fmt ", compulsory off"
211
+
| 3 -> Format.fprintf fmt ", auto"
212
+
| _ -> ());
213
+
if not function_present then Format.fprintf fmt ", no flash function";
214
+
if red_eye then Format.fprintf fmt ", red-eye reduction"
215
+
216
+
let pp_color_space fmt = function
217
+
| 1 -> Format.fprintf fmt "sRGB"
218
+
| 65535 -> Format.fprintf fmt "Uncalibrated"
219
+
| n -> Format.fprintf fmt "Unknown (%d)" n
220
+
221
+
let pp_exposure_mode fmt = function
222
+
| 0 -> Format.fprintf fmt "Auto"
223
+
| 1 -> Format.fprintf fmt "Manual"
224
+
| 2 -> Format.fprintf fmt "Auto bracket"
225
+
| n -> Format.fprintf fmt "Unknown (%d)" n
226
+
227
+
let pp_white_balance fmt = function
228
+
| 0 -> Format.fprintf fmt "Auto"
229
+
| 1 -> Format.fprintf fmt "Manual"
230
+
| n -> Format.fprintf fmt "Unknown (%d)" n
231
+
232
+
let pp_scene_capture_type fmt = function
233
+
| 0 -> Format.fprintf fmt "Standard"
234
+
| 1 -> Format.fprintf fmt "Landscape"
235
+
| 2 -> Format.fprintf fmt "Portrait"
236
+
| 3 -> Format.fprintf fmt "Night scene"
237
+
| n -> Format.fprintf fmt "Unknown (%d)" n
238
+
239
+
let pp_contrast fmt = function
240
+
| 0 -> Format.fprintf fmt "Normal"
241
+
| 1 -> Format.fprintf fmt "Soft"
242
+
| 2 -> Format.fprintf fmt "Hard"
243
+
| n -> Format.fprintf fmt "Unknown (%d)" n
244
+
245
+
let pp_saturation fmt = function
246
+
| 0 -> Format.fprintf fmt "Normal"
247
+
| 1 -> Format.fprintf fmt "Low"
248
+
| 2 -> Format.fprintf fmt "High"
249
+
| n -> Format.fprintf fmt "Unknown (%d)" n
250
+
251
+
let pp_sharpness fmt = function
252
+
| 0 -> Format.fprintf fmt "Normal"
253
+
| 1 -> Format.fprintf fmt "Soft"
254
+
| 2 -> Format.fprintf fmt "Hard"
255
+
| n -> Format.fprintf fmt "Unknown (%d)" n
256
+
257
+
let pp_sensing_method fmt = function
258
+
| 1 -> Format.fprintf fmt "Not defined"
259
+
| 2 -> Format.fprintf fmt "One-chip color area sensor"
260
+
| 3 -> Format.fprintf fmt "Two-chip color area sensor"
261
+
| 4 -> Format.fprintf fmt "Three-chip color area sensor"
262
+
| 5 -> Format.fprintf fmt "Color sequential area sensor"
263
+
| 7 -> Format.fprintf fmt "Trilinear sensor"
264
+
| 8 -> Format.fprintf fmt "Color sequential linear sensor"
265
+
| n -> Format.fprintf fmt "Unknown (%d)" n
266
+
267
+
let pp_compression fmt = function
268
+
| 1 -> Format.fprintf fmt "Uncompressed"
269
+
| 6 -> Format.fprintf fmt "JPEG"
270
+
| n -> Format.fprintf fmt "Unknown (%d)" n
271
+
272
+
let pp_gps_altitude_ref fmt = function
273
+
| 0 -> Format.fprintf fmt "Above sea level"
274
+
| 1 -> Format.fprintf fmt "Below sea level"
275
+
| n -> Format.fprintf fmt "Unknown (%d)" n
276
+
277
+
(** Format exposure time as fraction *)
278
+
let pp_exposure_time fmt r =
279
+
let num = Int32.to_float r.numerator in
280
+
let den = Int32.to_float r.denominator in
281
+
if den = 0. then
282
+
Format.fprintf fmt "Invalid"
283
+
else
284
+
let t = num /. den in
285
+
if t >= 1. then
286
+
Format.fprintf fmt "%.1f sec" t
287
+
else if t >= 0.1 then
288
+
Format.fprintf fmt "1/%.0f sec" (1. /. t)
289
+
else
290
+
Format.fprintf fmt "1/%.0f sec" (den /. num)
291
+
292
+
(** Format f-number *)
293
+
let pp_fnumber fmt r =
294
+
let f = Int32.to_float r.numerator /. Int32.to_float r.denominator in
295
+
Format.fprintf fmt "f/%.1f" f
296
+
297
+
(** Format focal length *)
298
+
let pp_focal_length fmt r =
299
+
let f = Int32.to_float r.numerator /. Int32.to_float r.denominator in
300
+
Format.fprintf fmt "%.1f mm" f
301
+
302
+
(** Format GPS coordinates in DMS *)
303
+
let pp_gps_coord fmt arr ref_str =
304
+
if Array.length arr >= 3 then
305
+
let d = Int32.to_float arr.(0).numerator /. Int32.to_float arr.(0).denominator in
306
+
let m = Int32.to_float arr.(1).numerator /. Int32.to_float arr.(1).denominator in
307
+
let s = Int32.to_float arr.(2).numerator /. Int32.to_float arr.(2).denominator in
308
+
Format.fprintf fmt "%.0f° %.0f' %.2f\" %s (%.6f°)"
309
+
d m s ref_str (d +. m /. 60. +. s /. 3600.)
310
+
else
311
+
Format.fprintf fmt "Invalid"
312
+
313
+
(** {1 Entry Pretty Printer} *)
314
+
315
+
let get_short_value = function
316
+
| VShort [| v |] -> Some v
317
+
| _ -> None
318
+
319
+
let get_rational_value = function
320
+
| VRational [| r |] -> Some r
321
+
| _ -> None
322
+
323
+
let get_byte_value = function
324
+
| VByte [| v |] -> Some v
325
+
| _ -> None
326
+
327
+
(** Print entry with semantic interpretation where applicable *)
328
+
let pp_entry_interpreted fmt entry =
329
+
let tag_name = Tag.name_of_tag entry.tag entry.ifd in
330
+
Format.fprintf fmt "@[<h>%-30s " tag_name;
331
+
332
+
(* Try to interpret known tags semantically *)
333
+
let interpreted = match entry.tag, entry.ifd with
334
+
| 0x0112, (IFD0 | IFD1) -> (* Orientation *)
335
+
Option.map (fun v -> pp_orientation fmt v) (get_short_value entry.value)
336
+
| 0x0128, (IFD0 | IFD1) -> (* ResolutionUnit *)
337
+
Option.map (fun v -> pp_resolution_unit fmt v) (get_short_value entry.value)
338
+
| 0x0103, (IFD0 | IFD1) -> (* Compression *)
339
+
Option.map (fun v -> pp_compression fmt v) (get_short_value entry.value)
340
+
| 0x8822, EXIF -> (* ExposureProgram *)
341
+
Option.map (fun v -> pp_exposure_program fmt v) (get_short_value entry.value)
342
+
| 0x9207, EXIF -> (* MeteringMode *)
343
+
Option.map (fun v -> pp_metering_mode fmt v) (get_short_value entry.value)
344
+
| 0x9208, EXIF -> (* LightSource *)
345
+
Option.map (fun v -> pp_light_source fmt v) (get_short_value entry.value)
346
+
| 0x9209, EXIF -> (* Flash *)
347
+
Option.map (fun v -> pp_flash fmt v) (get_short_value entry.value)
348
+
| 0xA001, EXIF -> (* ColorSpace *)
349
+
Option.map (fun v -> pp_color_space fmt v) (get_short_value entry.value)
350
+
| 0xA402, EXIF -> (* ExposureMode *)
351
+
Option.map (fun v -> pp_exposure_mode fmt v) (get_short_value entry.value)
352
+
| 0xA403, EXIF -> (* WhiteBalance *)
353
+
Option.map (fun v -> pp_white_balance fmt v) (get_short_value entry.value)
354
+
| 0xA406, EXIF -> (* SceneCaptureType *)
355
+
Option.map (fun v -> pp_scene_capture_type fmt v) (get_short_value entry.value)
356
+
| 0xA408, EXIF -> (* Contrast *)
357
+
Option.map (fun v -> pp_contrast fmt v) (get_short_value entry.value)
358
+
| 0xA409, EXIF -> (* Saturation *)
359
+
Option.map (fun v -> pp_saturation fmt v) (get_short_value entry.value)
360
+
| 0xA40A, EXIF -> (* Sharpness *)
361
+
Option.map (fun v -> pp_sharpness fmt v) (get_short_value entry.value)
362
+
| 0xA217, EXIF -> (* SensingMethod *)
363
+
Option.map (fun v -> pp_sensing_method fmt v) (get_short_value entry.value)
364
+
| 0x829A, EXIF -> (* ExposureTime *)
365
+
Option.map (fun r -> pp_exposure_time fmt r) (get_rational_value entry.value)
366
+
| 0x829D, EXIF -> (* FNumber *)
367
+
Option.map (fun r -> pp_fnumber fmt r) (get_rational_value entry.value)
368
+
| 0x920A, EXIF -> (* FocalLength *)
369
+
Option.map (fun r -> pp_focal_length fmt r) (get_rational_value entry.value)
370
+
| 0x0005, GPS -> (* GPSAltitudeRef *)
371
+
Option.map (fun v -> pp_gps_altitude_ref fmt v) (get_byte_value entry.value)
372
+
| _ -> None
373
+
in
374
+
375
+
if Option.is_none interpreted then
376
+
pp_value fmt entry.value;
377
+
378
+
Format.fprintf fmt "@]"
379
+
380
+
(** {1 Full EXIF Pretty Printer} *)
381
+
382
+
let pp_exif fmt exif =
383
+
Format.fprintf fmt "@[<v>";
384
+
Format.fprintf fmt "Byte order: %a@," pp_byte_order exif.byte_order;
385
+
Format.fprintf fmt "Entries: %d@,@," (List.length exif.entries);
386
+
387
+
(* Group entries by IFD *)
388
+
let ifds = [IFD0; EXIF; GPS; IFD1; Interoperability] in
389
+
List.iter (fun ifd ->
390
+
let entries = Exif.entries_in_ifd ifd exif in
391
+
if entries <> [] then begin
392
+
Format.fprintf fmt "@[<v 2>[%a]@," pp_ifd ifd;
393
+
List.iter (fun e ->
394
+
Format.fprintf fmt "%a@," pp_entry_interpreted e) entries;
395
+
Format.fprintf fmt "@]@,"
396
+
end) ifds;
397
+
398
+
(* Thumbnail info *)
399
+
(match exif.thumbnail with
400
+
| Some thumb ->
401
+
Format.fprintf fmt "@,Thumbnail: %d bytes (JPEG)" (Bytes.length thumb)
402
+
| None -> ());
403
+
404
+
Format.fprintf fmt "@]"
405
+
406
+
(** Print to string *)
407
+
let to_string exif =
408
+
Format.asprintf "%a" pp_exif exif
409
+
410
+
(** Print entry to string *)
411
+
let entry_to_string entry =
412
+
Format.asprintf "%a" pp_entry_interpreted entry
+151
project/ocaml-exif/src/exif_pp.mli
+151
project/ocaml-exif/src/exif_pp.mli
···
1
+
(** {1 EXIF Pretty Printing}
2
+
3
+
Comprehensive formatters for all EXIF types with human-readable
4
+
output for common tag values.
5
+
6
+
{2 Overview}
7
+
8
+
This module provides Format-style pretty printers for EXIF data types.
9
+
Many EXIF tags have enumerated values with specific meanings defined in
10
+
the {{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
11
+
EXIF 2.32 Specification}. These printers decode enumerated values to
12
+
human-readable descriptions.
13
+
14
+
{2 Example}
15
+
16
+
{[
17
+
let () =
18
+
let exif = Exif.parse data in
19
+
Format.printf "%a@." Exif_pp.pp_exif exif
20
+
]} *)
21
+
22
+
open Exif
23
+
24
+
(** {1 Basic Type Printers} *)
25
+
26
+
val pp_byte_order : Format.formatter -> byte_order -> unit
27
+
(** Print byte order as "Big-endian (Motorola)" or "Little-endian (Intel)". *)
28
+
29
+
val pp_format : Format.formatter -> format -> unit
30
+
(** Print data format name (e.g., "BYTE", "RATIONAL", "ASCII"). *)
31
+
32
+
val pp_ifd : Format.formatter -> ifd -> unit
33
+
(** Print IFD name (e.g., "IFD0", "EXIF", "GPS"). *)
34
+
35
+
(** {1 Value Printers} *)
36
+
37
+
val pp_rational : Format.formatter -> rational -> unit
38
+
(** Print rational value. Shows as "num/denom (decimal)" or just
39
+
the simplified value if denominator is 1. *)
40
+
41
+
val pp_srational : Format.formatter -> srational -> unit
42
+
(** Print signed rational value. *)
43
+
44
+
val pp_bytes_hex : Format.formatter -> bytes -> unit
45
+
(** Print bytes as hex. Truncates after 32 bytes. *)
46
+
47
+
val pp_value : Format.formatter -> value -> unit
48
+
(** Print any EXIF value. Arrays are formatted with brackets. *)
49
+
50
+
(** {1 Semantic Interpreters}
51
+
52
+
These printers decode enumerated tag values to human-readable
53
+
descriptions per the EXIF specification. *)
54
+
55
+
val pp_orientation : Format.formatter -> int -> unit
56
+
(** Print orientation value (1-8) as description.
57
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
58
+
EXIF 2.32 Section 4.6.4.A Orientation} *)
59
+
60
+
val pp_resolution_unit : Format.formatter -> int -> unit
61
+
(** Print resolution unit (1=none, 2=inches, 3=cm). *)
62
+
63
+
val pp_exposure_program : Format.formatter -> int -> unit
64
+
(** Print exposure program (0-8: Manual, Aperture Priority, etc).
65
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
66
+
EXIF 2.32 Section 4.6.5.B ExposureProgram} *)
67
+
68
+
val pp_metering_mode : Format.formatter -> int -> unit
69
+
(** Print metering mode (1-6: Average, Spot, Pattern, etc).
70
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
71
+
EXIF 2.32 Section 4.6.5.E MeteringMode} *)
72
+
73
+
val pp_light_source : Format.formatter -> int -> unit
74
+
(** Print light source/white balance preset (0-24).
75
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
76
+
EXIF 2.32 Section 4.6.5.F LightSource} *)
77
+
78
+
val pp_flash : Format.formatter -> int -> unit
79
+
(** Print flash status bit field as description.
80
+
Decodes fired status, return detection, mode, and red-eye reduction.
81
+
{{:https://www.cipa.jp/std/documents/e/DC-X008-Translation-2019-E.pdf}
82
+
EXIF 2.32 Section 4.6.5.G Flash} *)
83
+
84
+
val pp_color_space : Format.formatter -> int -> unit
85
+
(** Print color space (1=sRGB, 65535=Uncalibrated). *)
86
+
87
+
val pp_exposure_mode : Format.formatter -> int -> unit
88
+
(** Print exposure mode (0=Auto, 1=Manual, 2=Auto bracket). *)
89
+
90
+
val pp_white_balance : Format.formatter -> int -> unit
91
+
(** Print white balance mode (0=Auto, 1=Manual). *)
92
+
93
+
val pp_scene_capture_type : Format.formatter -> int -> unit
94
+
(** Print scene capture type (0=Standard, 1=Landscape, 2=Portrait, 3=Night). *)
95
+
96
+
val pp_contrast : Format.formatter -> int -> unit
97
+
(** Print contrast setting (0=Normal, 1=Soft, 2=Hard). *)
98
+
99
+
val pp_saturation : Format.formatter -> int -> unit
100
+
(** Print saturation setting (0=Normal, 1=Low, 2=High). *)
101
+
102
+
val pp_sharpness : Format.formatter -> int -> unit
103
+
(** Print sharpness setting (0=Normal, 1=Soft, 2=Hard). *)
104
+
105
+
val pp_sensing_method : Format.formatter -> int -> unit
106
+
(** Print sensor type (1-8: One-chip, Three-chip, Trilinear, etc). *)
107
+
108
+
val pp_compression : Format.formatter -> int -> unit
109
+
(** Print compression type (1=Uncompressed, 6=JPEG). *)
110
+
111
+
val pp_gps_altitude_ref : Format.formatter -> int -> unit
112
+
(** Print GPS altitude reference (0=above, 1=below sea level). *)
113
+
114
+
(** {1 Formatted Value Printers}
115
+
116
+
Printers for specific EXIF values with appropriate units. *)
117
+
118
+
val pp_exposure_time : Format.formatter -> rational -> unit
119
+
(** Print exposure time as fraction (e.g., "1/250 sec"). *)
120
+
121
+
val pp_fnumber : Format.formatter -> rational -> unit
122
+
(** Print f-number (e.g., "f/2.8"). *)
123
+
124
+
val pp_focal_length : Format.formatter -> rational -> unit
125
+
(** Print focal length (e.g., "50.0 mm"). *)
126
+
127
+
val pp_gps_coord : Format.formatter -> rational array -> string -> unit
128
+
(** Print GPS coordinate in DMS format with decimal conversion.
129
+
@param arr Array of 3 rationals: degrees, minutes, seconds
130
+
@param ref_str Direction reference ("N", "S", "E", or "W") *)
131
+
132
+
(** {1 Entry Printers} *)
133
+
134
+
val pp_entry_interpreted : Format.formatter -> entry -> unit
135
+
(** Print entry with semantic interpretation.
136
+
Known enumerated values are decoded to descriptions.
137
+
Unknown values are printed as raw values. *)
138
+
139
+
(** {1 Full EXIF Printer} *)
140
+
141
+
val pp_exif : Format.formatter -> t -> unit
142
+
(** Print complete EXIF data, organized by IFD.
143
+
Includes byte order, entry count, and thumbnail info. *)
144
+
145
+
(** {1 String Conversions} *)
146
+
147
+
val to_string : t -> string
148
+
(** Convert EXIF data to formatted string. *)
149
+
150
+
val entry_to_string : entry -> string
151
+
(** Convert single entry to string with interpretation. *)
+297
project/ocaml-exif/test/test_exif.ml
+297
project/ocaml-exif/test/test_exif.ml
···
1
+
(** Tests for the Exif library *)
2
+
3
+
open Alcotest
4
+
5
+
(** {1 Test Helpers} *)
6
+
7
+
(** Create a minimal EXIF structure with given entries *)
8
+
let make_exif ?(byte_order = Exif.Little_endian) entries =
9
+
{ Exif.byte_order; entries; thumbnail = None }
10
+
11
+
(** Create a test IFD entry *)
12
+
let make_entry ?(ifd = Exif.IFD0) ?(format = Exif.Ascii) ?(components = 1) tag value =
13
+
{ Exif.tag; ifd; format; components; value }
14
+
15
+
(** {1 Value Extraction Tests} *)
16
+
17
+
let test_get_string () =
18
+
let entry = make_entry 0x010F (Exif.VAscii "Canon") in
19
+
check (option string) "ASCII value" (Some "Canon") (Exif.get_string entry);
20
+
let entry2 = make_entry 0x010F (Exif.VShort [| 42 |]) in
21
+
check (option string) "Non-ASCII value" None (Exif.get_string entry2)
22
+
23
+
let test_get_short () =
24
+
let entry = make_entry ~format:Exif.Short 0x0112 (Exif.VShort [| 6 |]) in
25
+
check (option int) "SHORT value" (Some 6) (Exif.get_short entry);
26
+
let entry2 = make_entry 0x0112 (Exif.VShort [| 1; 2 |]) in
27
+
check (option int) "Multi-value SHORT" None (Exif.get_short entry2)
28
+
29
+
let test_get_long () =
30
+
let entry = make_entry ~format:Exif.Long 0x0100 (Exif.VLong [| 1920l |]) in
31
+
check (option int) "LONG value" (Some 1920) (Exif.get_long entry);
32
+
let entry2 = make_entry 0x0100 (Exif.VAscii "test") in
33
+
check (option int) "Non-LONG value" None (Exif.get_long entry2)
34
+
35
+
let test_get_rational () =
36
+
let entry =
37
+
make_entry ~format:Exif.Rational 0x829A
38
+
(Exif.VRational [| { Exif.numerator = 1l; denominator = 100l } |])
39
+
in
40
+
check (option (float 0.0001)) "RATIONAL value"
41
+
(Some 0.01) (Exif.get_rational entry);
42
+
(* Test divide by zero protection *)
43
+
let entry2 =
44
+
make_entry ~format:Exif.Rational 0x829A
45
+
(Exif.VRational [| { Exif.numerator = 1l; denominator = 0l } |])
46
+
in
47
+
check (option (float 0.0)) "Divide by zero" None (Exif.get_rational entry2)
48
+
49
+
(** {1 Metadata Accessor Tests} *)
50
+
51
+
let test_make_model () =
52
+
let exif = make_exif [
53
+
make_entry Exif.Tag.make (Exif.VAscii "Canon");
54
+
make_entry Exif.Tag.model (Exif.VAscii "EOS 5D Mark IV");
55
+
] in
56
+
check (option string) "make" (Some "Canon") (Exif.make exif);
57
+
check (option string) "model" (Some "EOS 5D Mark IV") (Exif.model exif)
58
+
59
+
let test_date_time () =
60
+
let exif = make_exif [
61
+
make_entry ~ifd:Exif.EXIF Exif.Tag.date_time_original
62
+
(Exif.VAscii "2024:12:25 10:30:00");
63
+
make_entry Exif.Tag.date_time
64
+
(Exif.VAscii "2024:12:26 14:00:00");
65
+
] in
66
+
check (option string) "date_time_original"
67
+
(Some "2024:12:25 10:30:00") (Exif.date_time_original exif);
68
+
check (option string) "date_time"
69
+
(Some "2024:12:26 14:00:00") (Exif.date_time exif)
70
+
71
+
let test_orientation () =
72
+
let exif = make_exif [
73
+
make_entry ~format:Exif.Short Exif.Tag.orientation (Exif.VShort [| 6 |]);
74
+
] in
75
+
check (option int) "orientation" (Some 6) (Exif.orientation exif)
76
+
77
+
let test_exposure_settings () =
78
+
let exif = make_exif [
79
+
make_entry ~ifd:Exif.EXIF ~format:Exif.Rational Exif.Tag.exposure_time
80
+
(Exif.VRational [| { Exif.numerator = 1l; denominator = 250l } |]);
81
+
make_entry ~ifd:Exif.EXIF ~format:Exif.Rational Exif.Tag.f_number
82
+
(Exif.VRational [| { Exif.numerator = 28l; denominator = 10l } |]);
83
+
make_entry ~ifd:Exif.EXIF ~format:Exif.Short Exif.Tag.iso_speed_ratings
84
+
(Exif.VShort [| 400 |]);
85
+
make_entry ~ifd:Exif.EXIF ~format:Exif.Rational Exif.Tag.focal_length
86
+
(Exif.VRational [| { Exif.numerator = 50l; denominator = 1l } |]);
87
+
] in
88
+
check (option (float 0.0001)) "exposure_time"
89
+
(Some 0.004) (Exif.exposure_time exif);
90
+
check (option (float 0.01)) "f_number"
91
+
(Some 2.8) (Exif.f_number exif);
92
+
check (option int) "iso_speed" (Some 400) (Exif.iso_speed exif);
93
+
check (option (float 0.1)) "focal_length"
94
+
(Some 50.0) (Exif.focal_length exif)
95
+
96
+
(** {1 GPS Tests} *)
97
+
98
+
let test_gps_coordinates () =
99
+
let exif = make_exif [
100
+
make_entry ~ifd:Exif.GPS Exif.Tag.gps_latitude_ref (Exif.VAscii "N");
101
+
make_entry ~ifd:Exif.GPS ~format:Exif.Rational Exif.Tag.gps_latitude
102
+
(Exif.VRational [|
103
+
{ Exif.numerator = 37l; denominator = 1l };
104
+
{ Exif.numerator = 46l; denominator = 1l };
105
+
{ Exif.numerator = 2952l; denominator = 100l };
106
+
|]);
107
+
make_entry ~ifd:Exif.GPS Exif.Tag.gps_longitude_ref (Exif.VAscii "W");
108
+
make_entry ~ifd:Exif.GPS ~format:Exif.Rational Exif.Tag.gps_longitude
109
+
(Exif.VRational [|
110
+
{ Exif.numerator = 122l; denominator = 1l };
111
+
{ Exif.numerator = 25l; denominator = 1l };
112
+
{ Exif.numerator = 900l; denominator = 100l };
113
+
|]);
114
+
] in
115
+
(* San Francisco coordinates: ~37.7749, -122.4194 *)
116
+
let lat = Exif.gps_latitude exif in
117
+
let lon = Exif.gps_longitude exif in
118
+
check bool "latitude present" true (Option.is_some lat);
119
+
check bool "longitude present" true (Option.is_some lon);
120
+
check (option (float 0.001)) "latitude value"
121
+
(Some 37.7749) lat;
122
+
check (option (float 0.001)) "longitude value (negative for West)"
123
+
(Some (-122.4192)) lon
124
+
125
+
let test_gps_altitude () =
126
+
let exif = make_exif [
127
+
make_entry ~ifd:Exif.GPS ~format:Exif.Byte Exif.Tag.gps_altitude_ref
128
+
(Exif.VByte [| 0 |]); (* Above sea level *)
129
+
make_entry ~ifd:Exif.GPS ~format:Exif.Rational Exif.Tag.gps_altitude
130
+
(Exif.VRational [| { Exif.numerator = 100l; denominator = 1l } |]);
131
+
] in
132
+
check (option (float 0.1)) "altitude" (Some 100.0) (Exif.gps_altitude exif);
133
+
(* Test below sea level *)
134
+
let exif2 = make_exif [
135
+
make_entry ~ifd:Exif.GPS ~format:Exif.Byte Exif.Tag.gps_altitude_ref
136
+
(Exif.VByte [| 1 |]); (* Below sea level *)
137
+
make_entry ~ifd:Exif.GPS ~format:Exif.Rational Exif.Tag.gps_altitude
138
+
(Exif.VRational [| { Exif.numerator = 50l; denominator = 1l } |]);
139
+
] in
140
+
check (option (float 0.1)) "altitude below sea level"
141
+
(Some (-50.0)) (Exif.gps_altitude exif2)
142
+
143
+
(** {1 Query Function Tests} *)
144
+
145
+
let test_find_entry () =
146
+
let exif = make_exif [
147
+
make_entry Exif.Tag.make (Exif.VAscii "Canon");
148
+
make_entry ~ifd:Exif.EXIF Exif.Tag.exposure_time
149
+
(Exif.VRational [| { Exif.numerator = 1l; denominator = 100l } |]);
150
+
] in
151
+
check bool "find Make" true
152
+
(Option.is_some (Exif.find_entry Exif.Tag.make exif));
153
+
check bool "find ExposureTime" true
154
+
(Option.is_some (Exif.find_entry Exif.Tag.exposure_time exif));
155
+
check bool "find missing tag" false
156
+
(Option.is_some (Exif.find_entry 0xFFFF exif))
157
+
158
+
let test_find_entry_in_ifd () =
159
+
let exif = make_exif [
160
+
make_entry ~ifd:Exif.IFD0 Exif.Tag.make (Exif.VAscii "Canon");
161
+
make_entry ~ifd:Exif.EXIF Exif.Tag.make (Exif.VAscii "Not real");
162
+
] in
163
+
let entry = Exif.find_entry_in_ifd Exif.Tag.make Exif.IFD0 exif in
164
+
check bool "found in IFD0" true (Option.is_some entry);
165
+
check (option string) "correct IFD value" (Some "Canon")
166
+
(Option.bind entry Exif.get_string)
167
+
168
+
let test_entries_in_ifd () =
169
+
let exif = make_exif [
170
+
make_entry ~ifd:Exif.IFD0 Exif.Tag.make (Exif.VAscii "Canon");
171
+
make_entry ~ifd:Exif.IFD0 Exif.Tag.model (Exif.VAscii "EOS 5D");
172
+
make_entry ~ifd:Exif.EXIF Exif.Tag.exposure_time
173
+
(Exif.VRational [| { Exif.numerator = 1l; denominator = 100l } |]);
174
+
] in
175
+
let ifd0_entries = Exif.entries_in_ifd Exif.IFD0 exif in
176
+
let exif_entries = Exif.entries_in_ifd Exif.EXIF exif in
177
+
check int "IFD0 entry count" 2 (List.length ifd0_entries);
178
+
check int "EXIF entry count" 1 (List.length exif_entries)
179
+
180
+
(** {1 Pretty Printing Tests} *)
181
+
182
+
let test_string_of_value () =
183
+
check string "ASCII" "Hello" (Exif.string_of_value (Exif.VAscii "Hello"));
184
+
check string "SHORT" "1 2 3" (Exif.string_of_value (Exif.VShort [| 1; 2; 3 |]));
185
+
check string "LONG" "1000" (Exif.string_of_value (Exif.VLong [| 1000l |]));
186
+
check string "RATIONAL" "1/100"
187
+
(Exif.string_of_value
188
+
(Exif.VRational [| { Exif.numerator = 1l; denominator = 100l } |]))
189
+
190
+
let test_string_of_entry () =
191
+
let entry = make_entry Exif.Tag.make (Exif.VAscii "Canon") in
192
+
check string "Make entry" "Make: Canon" (Exif.string_of_entry entry)
193
+
194
+
let test_string_of_ifd () =
195
+
check string "IFD0" "IFD0" (Exif.string_of_ifd Exif.IFD0);
196
+
check string "EXIF" "EXIF" (Exif.string_of_ifd Exif.EXIF);
197
+
check string "GPS" "GPS" (Exif.string_of_ifd Exif.GPS)
198
+
199
+
(** {1 Tag Name Tests} *)
200
+
201
+
let test_tag_name_of_tag () =
202
+
check string "Make tag" "Make"
203
+
(Exif.Tag.name_of_tag 0x010F Exif.IFD0);
204
+
check string "ExposureTime tag" "ExposureTime"
205
+
(Exif.Tag.name_of_tag 0x829A Exif.EXIF);
206
+
check string "GPSLatitude tag" "GPSLatitude"
207
+
(Exif.Tag.name_of_tag 0x0002 Exif.GPS);
208
+
check string "Unknown tag" "Tag_0xFFFF"
209
+
(Exif.Tag.name_of_tag 0xFFFF Exif.IFD0)
210
+
211
+
(** {1 Binary Parsing Tests} *)
212
+
213
+
let test_parse_minimal_exif () =
214
+
(* Create minimal valid EXIF data:
215
+
- Little endian "II"
216
+
- TIFF magic 42
217
+
- IFD0 offset at byte 8
218
+
- IFD0 with 1 entry: Make = "OK"
219
+
*)
220
+
let data = Bytes.create 32 in
221
+
(* Byte order: "II" (little endian) *)
222
+
Bytes.set data 0 'I';
223
+
Bytes.set data 1 'I';
224
+
(* Magic: 42 in little endian *)
225
+
Bytes.set_uint16_le data 2 42;
226
+
(* IFD0 offset: 8 *)
227
+
Bytes.set_int32_le data 4 8l;
228
+
(* IFD0: 1 entry *)
229
+
Bytes.set_uint16_le data 8 1;
230
+
(* Entry: tag=0x010F (Make), format=2 (ASCII), count=3, value="OK\0" *)
231
+
Bytes.set_uint16_le data 10 0x010F; (* tag *)
232
+
Bytes.set_uint16_le data 12 2; (* format: ASCII *)
233
+
Bytes.set_int32_le data 14 3l; (* count: 3 bytes incl NUL *)
234
+
(* Value fits in 4 bytes, so inline: "OK\0" padded *)
235
+
Bytes.set data 18 'O';
236
+
Bytes.set data 19 'K';
237
+
Bytes.set data 20 '\000';
238
+
Bytes.set data 21 '\000';
239
+
(* Next IFD offset: 0 (none) *)
240
+
Bytes.set_int32_le data 22 0l;
241
+
242
+
let exif = Exif.parse data in
243
+
check (option string) "parsed Make" (Some "OK") (Exif.make exif);
244
+
check bool "little endian" true
245
+
(exif.byte_order = Exif.Little_endian)
246
+
247
+
let test_parse_error_short_data () =
248
+
let data = Bytes.create 4 in
249
+
check_raises "short data" (Exif.Parse_error "Data too short for EXIF header")
250
+
(fun () -> ignore (Exif.parse data))
251
+
252
+
let test_parse_error_bad_byte_order () =
253
+
let data = Bytes.create 8 in
254
+
Bytes.set data 0 'X';
255
+
Bytes.set data 1 'X';
256
+
check_raises "bad byte order" (Exif.Parse_error "Invalid byte order marker")
257
+
(fun () -> ignore (Exif.parse data))
258
+
259
+
(** {1 Test Suite} *)
260
+
261
+
let () =
262
+
run "Exif" [
263
+
"value_extraction", [
264
+
test_case "get_string" `Quick test_get_string;
265
+
test_case "get_short" `Quick test_get_short;
266
+
test_case "get_long" `Quick test_get_long;
267
+
test_case "get_rational" `Quick test_get_rational;
268
+
];
269
+
"metadata_accessors", [
270
+
test_case "make_model" `Quick test_make_model;
271
+
test_case "date_time" `Quick test_date_time;
272
+
test_case "orientation" `Quick test_orientation;
273
+
test_case "exposure_settings" `Quick test_exposure_settings;
274
+
];
275
+
"gps", [
276
+
test_case "gps_coordinates" `Quick test_gps_coordinates;
277
+
test_case "gps_altitude" `Quick test_gps_altitude;
278
+
];
279
+
"query_functions", [
280
+
test_case "find_entry" `Quick test_find_entry;
281
+
test_case "find_entry_in_ifd" `Quick test_find_entry_in_ifd;
282
+
test_case "entries_in_ifd" `Quick test_entries_in_ifd;
283
+
];
284
+
"pretty_printing", [
285
+
test_case "string_of_value" `Quick test_string_of_value;
286
+
test_case "string_of_entry" `Quick test_string_of_entry;
287
+
test_case "string_of_ifd" `Quick test_string_of_ifd;
288
+
];
289
+
"tag_names", [
290
+
test_case "name_of_tag" `Quick test_tag_name_of_tag;
291
+
];
292
+
"binary_parsing", [
293
+
test_case "parse_minimal_exif" `Quick test_parse_minimal_exif;
294
+
test_case "parse_error_short_data" `Quick test_parse_error_short_data;
295
+
test_case "parse_error_bad_byte_order" `Quick test_parse_error_bad_byte_order;
296
+
];
297
+
]