open Pdfutil open Pdfio (* Extract Images. *) let pnm_to_channel_24 channel w h s = let white () = output_char channel ' ' and newline () = output_char channel '\n' and output_string = Stdlib.output_string channel in output_string "P6"; white (); output_string (string_of_int w); white (); output_string (string_of_int h); white (); output_string "255"; newline (); let pos = ref 0 in for y = 1 to h do for x = 1 to w * 3 do output_byte channel (bget s !pos); incr pos done done let jbig2_serial = ref 0 let jbig2_globals = null_hash () let write_stream name stream = let fh = open_out_bin name in Pdfio.bytes_to_output_channel fh stream; close_out fh let write_image ~raw ?path_to_p2p ?path_to_im pdf resources name image = match Pdfimage.get_image_24bpp pdf resources image with | Pdfimage.JPEG (stream, _) -> write_stream (name ^ ".jpg") stream | Pdfimage.JPEG2000 (stream, _) -> write_stream (name ^ ".jpx") stream | Pdfimage.JBIG2 (stream, _, global) -> begin match global with | None -> Printf.printf "JBIG2: No global, writing plain\n"; write_stream (name ^ ".jbig2") stream | Some g -> Printf.printf "JBIG2: there is a global\n"; let go () = let serial, _ = Hashtbl.find jbig2_globals g in write_stream (name ^ ".jbig2__" ^ string_of_int serial) stream in try go () with Not_found -> jbig2_serial += 1; let globaldata = let obj = Pdf.lookup_obj pdf g in Pdfcodec.decode_pdfstream_until_unknown pdf obj; match obj with | Pdf.Stream {contents = (_, Got b)} -> Some b | _ -> None in match globaldata with | Some d -> Hashtbl.add jbig2_globals g (!jbig2_serial, d); let filename = Filename.concat (Filename.dirname name) (string_of_int !jbig2_serial ^ ".jbig2global") in write_stream filename d; go () | None -> Pdfe.log "Could not extract JBIG2Globals. Skipping this image." end | Pdfimage.Raw (w, h, Pdfimage.BPP24, stream) -> let pnm = name ^ ".pnm" in let png = name ^ ".png" in let fh = open_out_bin pnm in pnm_to_channel_24 fh w h stream; close_out fh; begin match path_to_p2p with | None -> begin match path_to_im with None -> if not raw then Pdfe.log "Neither pnm2png nor imagemagick found. Specify with -p2p or -im\n" | Some path_to_im -> begin match Sys.command (Filename.quote_command path_to_im [pnm; png]) with 0 -> Sys.remove pnm | _ -> Pdfe.log "Call to imagemagick failed: did you specify -p2p or -im correctly?\n"; Sys.remove pnm end end | Some path_to_p2p -> begin match Sys.command (Filename.quote_command path_to_p2p ~stdout:png ["-gamma"; "0.45"; "-quiet"; pnm]) with | 0 -> Sys.remove pnm | _ -> Pdfe.log "Call to pnmtopng failed: did you specify -p2p correctly?\n"; Sys.remove pnm end end | _ -> Pdfe.log (Printf.sprintf "Unsupported image type when extracting image %s " name) let written = ref [] let extract_images_inner ~raw ?path_to_p2p ?path_to_im encoding serial pdf resources stem pnum images = let names = map (fun _ -> Cpdfbookmarks.name_of_spec encoding [] pdf 0 (stem ^ "-p" ^ string_of_int pnum) (let r = !serial in serial := !serial + 1; r) "" 0 0) (indx images) in iter2 (write_image ~raw ?path_to_p2p ?path_to_im pdf resources) names images let rec extract_images_form_xobject ~raw ?path_to_p2p ?path_to_im encoding dedup dedup_per_page pdf serial stem pnum form = let resources = match Pdf.lookup_direct pdf "/Resources" form with Some (Pdf.Dictionary d) -> Pdf.Dictionary d | _ -> Pdf.Dictionary [] in let images = let xobjects = match Pdf.lookup_direct pdf "/XObject" resources with | Some (Pdf.Dictionary elts) -> map snd elts | _ -> [] in (* Remove any already in !written. Add any remaining to !written, if !args.dedup or !args.dedup_page *) let images = keep (fun o -> Pdf.lookup_direct pdf "/Subtype" o = Some (Pdf.Name "/Image")) xobjects in let already_written, images = List.partition (function Pdf.Indirect n -> mem n !written | _ -> false) images in if dedup || dedup_per_page then written := (option_map (function Pdf.Indirect n -> Some n | _ -> None) images) @ !written; images in extract_images_inner ~raw ?path_to_p2p ?path_to_im encoding serial pdf resources stem pnum images let extract_images ?(raw=false) ?path_to_p2p ?path_to_im encoding dedup dedup_per_page pdf range stem = Hashtbl.clear jbig2_globals; jbig2_serial := 0; if dedup || dedup_per_page then written := []; let pdf_pages = Pdfpage.pages_of_pagetree pdf in let pages = option_map (function (i, pdf_pages) -> if mem i range then Some pdf_pages else None) (combine (indx pdf_pages) pdf_pages) in let serial = ref 0 in iter2 (fun page pnum -> if dedup_per_page then written := []; let xobjects = match Pdf.lookup_direct pdf "/XObject" page.Pdfpage.resources with | Some (Pdf.Dictionary elts) -> map snd elts | _ -> [] in let images = keep (fun o -> Pdf.lookup_direct pdf "/Subtype" o = Some (Pdf.Name "/Image")) xobjects in let already_written, images = List.partition (function Pdf.Indirect n -> mem n !written | _ -> false) images in if dedup || dedup_per_page then written := (option_map (function Pdf.Indirect n -> Some n | _ -> None) images) @ !written; let forms = keep (fun o -> Pdf.lookup_direct pdf "/Subtype" o = Some (Pdf.Name "/Form")) xobjects in extract_images_inner ~raw ?path_to_p2p ?path_to_im encoding serial pdf page.Pdfpage.resources stem pnum images; iter (extract_images_form_xobject ~raw ?path_to_p2p ?path_to_im encoding dedup dedup_per_page pdf serial stem pnum) forms) pages (indx pages) (* Image resolution *) type xobj = | Image of int * int (* width, height *) | Form of Pdftransform.transform_matrix * Pdf.pdfobject * Pdf.pdfobject (* Will add actual data later. *) let image_results = ref [] let add_image_result i = image_results := i::!image_results (* Given a page and a list of (pagenum, name, thing) *) let rec image_resolution_page pdf page pagenum dpi (images : (int * string * xobj) list) = try let pageops = Pdfops.parse_operators pdf page.Pdfpage.resources page.Pdfpage.content and transform = ref [ref Pdftransform.i_matrix] in iter (function | Pdfops.Op_cm matrix -> begin match !transform with | [] -> raise (Failure "no transform") | _ -> (hd !transform) := Pdftransform.matrix_compose !(hd !transform) matrix end | Pdfops.Op_Do xobject -> let trans (x, y) = match !transform with | [] -> raise (Failure "no transform") | _ -> Pdftransform.transform_matrix !(hd !transform) (x, y) in let o = trans (0., 0.) and x = trans (1., 0.) and y = trans (0., 1.) in (*i Printf.printf "o = %f, %f, x = %f, %f, y = %f, %f\n" (fst o) (snd o) (fst x) (snd x) (fst y) (snd y); i*) let rec lookup_image k = function | [] -> assert false | (_, a, _) as h::_ when a = k -> h | _::t -> lookup_image k t in begin match lookup_image xobject images with | (pagenum, name, Form (xobj_matrix, content, resources)) -> let content = (* Add in matrix etc. *) let total_matrix = Pdftransform.matrix_compose xobj_matrix !(hd !transform) in let ops = Pdfops.Op_cm total_matrix:: Pdfops.parse_operators pdf resources [content] in Pdfops.stream_of_ops ops in let page = {Pdfpage.content = [content]; Pdfpage.mediabox = Pdfpage.rectangle_of_paper Pdfpaper.a4; Pdfpage.resources = resources; Pdfpage.rotate = Pdfpage.Rotate0; Pdfpage.rest = Pdf.Dictionary []} in let newpdf = Pdfpage.change_pages false pdf [page] in image_resolution newpdf [pagenum] dpi | (pagenum, name, Image (w, h)) -> let lx = Pdfunits.points (distance_between o x) Pdfunits.Inch in let ly = Pdfunits.points (distance_between o y) Pdfunits.Inch in let wdpi = float w /. lx and hdpi = float h /. ly in add_image_result (pagenum, xobject, w, h, wdpi, hdpi) (*Printf.printf "%i, %s, %i, %i, %f, %f\n" pagenum xobject w h wdpi hdpi*) (*i else Printf.printf "S %i, %s, %i, %i, %f, %f\n" pagenum xobject (int_of_float w) (int_of_float h) wdpi hdpi i*) end | Pdfops.Op_q -> begin match !transform with | [] -> raise (Failure "Unbalanced q/Q ops") | h::t -> let h' = ref Pdftransform.i_matrix in h' := !h; transform := h'::h::t end | Pdfops.Op_Q -> begin match !transform with | [] -> raise (Failure "Unbalanced q/Q ops") | _ -> transform := tl !transform end | _ -> ()) pageops with e -> Printf.printf "Error %s\n" (Printexc.to_string e); flprint "\n" and image_resolution pdf range dpi = let images = ref [] in Cpdfpage.iter_pages (fun pagenum page -> (* 1. Get all image names and their native resolutions from resources as string * int * int *) match Pdf.lookup_direct pdf "/XObject" page.Pdfpage.resources with | Some (Pdf.Dictionary xobjects) -> iter (function (name, xobject) -> match Pdf.lookup_direct pdf "/Subtype" xobject with | Some (Pdf.Name "/Image") -> let width = match Pdf.lookup_direct pdf "/Width" xobject with | Some x -> Pdf.getnum pdf x | None -> 1. and height = match Pdf.lookup_direct pdf "/Height" xobject with | Some x -> Pdf.getnum pdf x | None -> 1. in images := (pagenum, name, Image (int_of_float width, int_of_float height))::!images | Some (Pdf.Name "/Form") -> let resources = match Pdf.lookup_direct pdf "/Resources" xobject with | None -> page.Pdfpage.resources (* Inherit from page or form above. *) | Some r -> r and contents = xobject and matrix = match Pdf.lookup_direct pdf "/Matrix" xobject with | Some (Pdf.Array [a; b; c; d; e; f]) -> {Pdftransform.a = Pdf.getnum pdf a; Pdftransform.b = Pdf.getnum pdf b; Pdftransform.c = Pdf.getnum pdf c; Pdftransform.d = Pdf.getnum pdf d; Pdftransform.e = Pdf.getnum pdf e; Pdftransform.f = Pdf.getnum pdf f} | _ -> Pdftransform.i_matrix in images := (pagenum, name, Form (matrix, contents, resources))::!images | _ -> () ) xobjects | _ -> ()) pdf range; (* Now, split into differing pages, and call [image_resolution_page] on each one *) let pagesplits = map (function (a, _, _)::_ as ls -> (a, ls) | _ -> assert false) (collate (fun (a, _, _) (b, _, _) -> compare a b) (rev !images)) and pages = Pdfpage.pages_of_pagetree pdf in iter (function (pagenum, images) -> let page = select pagenum pages in image_resolution_page pdf page pagenum dpi images) pagesplits let image_resolution pdf range dpi = image_results := []; image_resolution pdf range dpi; rev !image_results (* All the images in file referenced at least once from the given range of pages. *) let images pdf range = let images = null_hash () in let formnums = null_hash () in let rec process_xobject resources pagenum page (name, xobject) = match Pdf.lookup_direct pdf "/Subtype" xobject with | Some (Pdf.Name "/Image") -> begin match xobject with | Pdf.Indirect i -> begin match Hashtbl.find images i with | (pagenums, n, w, h, cs) -> Hashtbl.replace images i (pagenum::pagenums, n, w, h, cs) | exception Not_found -> let width = match Pdf.lookup_direct pdf "/Width" xobject with | Some x -> Pdf.getnum pdf x | None -> 1. and height = match Pdf.lookup_direct pdf "/Height" xobject with | Some x -> Pdf.getnum pdf x | None -> 1. and colourspace = match Pdf.lookup_direct pdf "/ColorSpace" xobject with | Some x -> Some (Pdfspace.string_of_colourspace (Pdfspace.read_colourspace pdf resources x)) | None -> None in Hashtbl.replace images i ([pagenum], name, int_of_float width, int_of_float height, colourspace) end | _ -> () end | Some (Pdf.Name "/Form") -> begin match xobject with | Pdf.Indirect i -> begin match Hashtbl.find formnums i with | () -> () | exception Not_found -> Hashtbl.add formnums i (); begin match Pdf.lookup_direct pdf "/Resources" xobject with | Some r -> begin match Pdf.lookup_direct pdf "/XObject" r with | Some (Pdf.Dictionary xobjects) -> iter (process_xobject r pagenum page) xobjects | _ -> () end | None -> () end end | _ -> () end | _ -> () in Cpdfpage.iter_pages (fun pagenum page -> match Pdf.lookup_direct pdf "/XObject" page.Pdfpage.resources with | Some (Pdf.Dictionary xobjects) -> iter (process_xobject page.Pdfpage.resources pagenum page) xobjects | _ -> ()) pdf range; let images = list_of_hashtbl images in let images = map (fun (i, (pnums, n, w, h, c)) -> (i, (setify (sort compare pnums), n, w, h, c))) images in let images = sort (fun (_, (pnums, _, _, _, _)) (_, (pnums', _, _, _, _)) -> compare (hd pnums) (hd pnums')) images in `List (map (fun (i, (pnums, n, w, h, cs)) -> `Assoc [("Object", `Int i); ("Pages", `List (map (fun x -> `Int x) pnums)); ("Name", `String n); ("Width", `Int w); ("Height", `Int h); ("Colourspace", match cs with None -> `Null | Some s -> `String s)]) images) let obj_of_jpeg_data data = let w, h = Cpdfjpeg.jpeg_dimensions data in let d = ["/Length", Pdf.Integer (Pdfio.bytes_size data); "/Filter", Pdf.Name "/DCTDecode"; "/BitsPerComponent", Pdf.Integer 8; "/ColorSpace", Pdf.Name "/DeviceRGB"; "/Subtype", Pdf.Name "/Image"; "/Width", Pdf.Integer w; "/Height", Pdf.Integer h] in Pdf.Stream {contents = (Pdf.Dictionary d, Pdf.Got data)}, [] let obj_of_png_data data = let png = Cpdfpng.read_png (Pdfio.input_of_bytes data) in let d = ["/Length", Pdf.Integer (Pdfio.bytes_size png.idat); "/Filter", Pdf.Name "/FlateDecode"; "/Subtype", Pdf.Name "/Image"; "/BitsPerComponent", Pdf.Integer 8; "/ColorSpace", Pdf.Name "/DeviceRGB"; "/DecodeParms", Pdf.Dictionary ["/BitsPerComponent", Pdf.Integer 8; "/Colors", Pdf.Integer 3; "/Columns", Pdf.Integer png.width; "/Predictor", Pdf.Integer 15]; "/Width", Pdf.Integer png.width; "/Height", Pdf.Integer png.height] in Pdf.Stream {contents = (Pdf.Dictionary d, Pdf.Got png.idat)}, [] let jbig2_dimensions data = (bget data 11 * 256 * 256 * 256 + bget data 12 * 256 * 256 + bget data 13 * 256 + bget data 14, bget data 15 * 256 * 256 * 256 + bget data 16 * 256 * 256 + bget data 17 * 256 + bget data 18) let obj_of_jbig2_data ?global:int data = let d = let w, h = jbig2_dimensions data in [("/Length", Pdf.Integer (Pdfio.bytes_size data)); ("/Filter", Pdf.Name "/JBIG2Decode"); ("/Subtype", Pdf.Name "/Image"); ("/BitsPerComponent", Pdf.Integer 1); ("/ColorSpace", Pdf.Name "/DeviceGray"); (* FIXME decodeparms for global *) ("/Width", Pdf.Integer w); ("/Height", Pdf.Integer h)] in Pdf.Stream {contents = (Pdf.Dictionary d, Pdf.Got data)}, [] let image_of_input fobj i = let pdf = Pdf.empty () in let data = Pdfio.bytes_of_input i 0 i.Pdfio.in_channel_length in let obj, extras = fobj data in let w = match Pdf.lookup_direct pdf "/Width" obj with Some x -> Pdf.getnum pdf x | _ -> assert false in let h = match Pdf.lookup_direct pdf "/Height" obj with Some x -> Pdf.getnum pdf x | _ -> assert false in let page = {Pdfpage.content = [Pdfops.stream_of_ops [Pdfops.Op_cm (Pdftransform.matrix_of_transform [Pdftransform.Translate (0., 0.); Pdftransform.Scale ((0., 0.), w, h)]); Pdfops.Op_Do "/I0"]]; Pdfpage.mediabox = Pdf.Array [Pdf.Real 0.; Pdf.Real 0.; Pdf.Real w; Pdf.Real h]; Pdfpage.resources = Pdf.Dictionary ["/XObject", Pdf.Dictionary ["/I0", Pdf.Indirect (Pdf.addobj pdf obj)]]; Pdfpage.rotate = Pdfpage.Rotate0; Pdfpage.rest = Pdf.Dictionary []} in let pdf, pageroot = Pdfpage.add_pagetree [page] pdf in Pdfpage.add_root pageroot [] pdf