Playing with XMP

This commit is contained in:
John Whitington 2014-10-13 18:16:06 +01:00
parent 2f8beb0e0d
commit 3af9d9d1aa
1 changed files with 40 additions and 11 deletions

51
cpdf.ml
View File

@ -1468,7 +1468,41 @@ let hasbox pdf page boxname =
| Some _ -> true
| _ -> false
(* \section{Print metadata} *)
type xmltree =
E of Xmlm.tag * xmltree list
| D of string
let xmltree_of_bytes b =
let i = Xmlm.make_input (`String (0, string_of_bytes b)) in
let el tag childs = E (tag, childs)
and data d = D d in
Xmlm.input_doc_tree ~el ~data i
let rec string_of_xmltree = function
D d ->
Printf.sprintf "DATA %s" d
| E (tag, trees) ->
Printf.sprintf "ELT (%s, %s)"
(string_of_tag tag)
(string_of_xmltrees trees)
and string_of_tag ((n, n'), attributes) =
Printf.sprintf
"NAME %s %s, ATTRIBUTES %s" n n'
(string_of_attributes attributes)
and string_of_attribute ((n, n'), str) =
Printf.sprintf "NAME %s %s, STR %s" n n' str
and string_of_attributes attrs =
fold_left
(fun a b -> a ^ " " ^ b) "" (map string_of_attribute attrs)
and string_of_xmltrees trees =
fold_left
(fun a b -> a ^ " " ^ b) "" (map string_of_xmltree trees)
(* Print metadata *)
let get_metadata pdf =
match Pdf.lookup_direct pdf "/Root" pdf.Pdf.trailerdict with
| None -> error "malformed file"
@ -1477,7 +1511,11 @@ let get_metadata pdf =
| Some ((Pdf.Stream _) as s) ->
Pdf.getstream s;
begin match s with
| Pdf.Stream {contents = (_, Pdf.Got data)} -> Some data
| Pdf.Stream {contents = (_, Pdf.Got data)} ->
(* Try to parse it with xmlm *)
let xmp = xmltree_of_bytes data in
print_endline (string_of_xmltree (snd xmp));
Some data
| _ -> assert false
end
| _ -> None
@ -3546,8 +3584,6 @@ let page1 labels =
let add_page_labels pdf style prefix startval range =
let ranges = map extremes (ranges_of_range [] [] range)
and labels = Pdfpagelabels.read pdf in
(*Printf.printf "We have %i existing labels\n" (List.length labels);
Printf.printf "We have %i ranges to apply these labels to\n" (List.length ranges);*)
let labels =
if not (page1 labels) then
ref
@ -3558,8 +3594,6 @@ let add_page_labels pdf style prefix startval range =
else
ref labels
in
(*Printf.printf "Before adding, we have these labels:\n";
iter (fun x -> flprint (Pdfpagelabels.string_of_pagelabel x)) !labels;*)
iter
(function (s, e) ->
let label =
@ -3568,12 +3602,7 @@ let add_page_labels pdf style prefix startval range =
Pdfpagelabels.startpage = s;
Pdfpagelabels.startvalue = startval}
in
(*Printf.printf "We are adding this label:\n";
flprint (Pdfpagelabels.string_of_pagelabel label);*)
labels := Pdfpagelabels.add_label (Pdfpage.endpage pdf) !labels label e)
ranges;
(*Printf.printf "After adding, we have these labels:\n";
iter (fun x -> flprint (Pdfpagelabels.string_of_pagelabel x)) !labels;*)
Pdfpagelabels.write pdf !labels