1 #!/usr/bin/ocamlrun /usr/bin/ocaml
2 (* Copyright (C) 2006, HELM Team.
4 * This file is part of HELM, an Hypertextual, Electronic
5 * Library of Mathematics, developed at the Computer Science
6 * Department, University of Bologna, Italy.
8 * HELM is free software; you can redistribute it and/or
9 * modify it under the terms of the GNU General Public License
10 * as published by the Free Software Foundation; either version 2
11 * of the License, or (at your option) any later version.
13 * HELM is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
18 * You should have received a copy of the GNU General Public License
19 * along with HELM; if not, write to the Free Software
20 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
23 * For details, see the HELM World-Wide-Web page,
24 * http://helm.cs.unibo.it/
29 with Invalid_argument _ ->
30 prerr_endline "Usage: split.ml <FILE.html>";
35 #require "pxp-engine";;
36 #require "pxp-lex-utf8";;
39 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
40 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
41 <html xmlns=\"http://www.w3.org/1999/xhtml\">
51 ('a Pxp_document.node #Pxp_document.extension as 'a) Pxp_document.node
54 Pxp_reader.lookup_public_id_as_file [
55 "-//W3C//DTD XHTML 1.0 Transitional//EN", "xhtml1-transitional.dtd";
56 "-//W3C//ENTITIES Latin 1 for XHTML//EN", "xhtml-lat1.ent";
57 "-//W3C//ENTITIES Symbols for XHTML//EN", "xhtml-symbol.ent";
58 "-//W3C//ENTITIES Special for XHTML//EN", "xhtml-special.ent"; ]
61 Pxp_tree_parser.parse_wfdocument_entity
62 { Pxp_types.default_config with Pxp_types.encoding = `Enc_utf8 }
63 (Pxp_types.from_file ~alt:[ resolver ] fname)
64 Pxp_tree_parser.default_spec
66 (** pattern matching like predicate on pxp nodes *)
67 let match_elt tag attr_name ?attr_value () node =
68 node#node_type = Pxp_document.T_element tag
69 && (match attr_value with
71 (try node#attribute attr_name = Pxp_types.Value attr_value
72 with Not_found -> false)
73 | None -> List.mem attr_name node#attribute_names)
78 Pxp_document.find ~deeply:true
79 (match_elt "div" "class" ~attr_value:"article" ()) doc#root
80 with Not_found -> failwith "Can't find article <div>" in
82 Pxp_document.find ~deeply:false
83 (match_elt "div" "class" ~attr_value:"titlepage" ()) article in
85 Pxp_document.find ~deeply:false
86 (match_elt "div" "class" ~attr_value:"toc" ()) article in
88 Pxp_document.find_all ~deeply:false
89 (match_elt "div" "class" ~attr_value:"sect1" ()) article in
90 titlepage :: toc :: secs
92 let localize_ids secs =
93 let id2sec = Hashtbl.create 1023 in
94 let sec_ids = ref [] in
97 match Pxp_document.find_all ~deeply:true (match_elt "a" "id" ()) sec with
99 let sec_id = sec_id#required_string_attribute "id" in
100 sec_ids := sec_id :: !sec_ids;
103 let id = id#required_string_attribute "id" in
104 Hashtbl.add id2sec id sec_id)
106 | _ -> failwith "can't find section id")
110 let fname_of_sec sec_name = sec_name ^ ".html"
112 let get_sec_name sec =
115 Pxp_document.find ~deeply:true (match_elt "a" "id" ()) sec
116 with Not_found -> failwith "can't find section id" in
117 id#required_string_attribute "id"
119 let iter_xrefs f node =
120 let a_s = Pxp_document.find_all ~deeply:true (match_elt "a" "href" ()) node in
122 (fun (node: 'a node) ->
123 let href = node#required_string_attribute "href" in
124 assert (String.length href > 0);
125 if href.[0] = '#' then
126 let xref = String.sub href 1 (String.length href - 1) in
130 let patch_toc sec_ids id2sec toc =
133 if List.mem xref sec_ids then
134 node#set_attribute "href" (Pxp_types.Value (fname_of_sec xref))
137 let sec = Hashtbl.find id2sec xref in
138 node#set_attribute "href"
139 (Pxp_types.Value (fname_of_sec sec ^ "#" ^ xref))
140 with Not_found -> ())
143 let patch_sec sec_ids id2sec sec =
144 let sec_name = get_sec_name sec in
148 let xref_sec = Hashtbl.find id2sec xref in
149 if xref_sec <> sec_name then
150 node#set_attribute "href"
151 (Pxp_types.Value (fname_of_sec xref_sec ^ "#" ^ xref))
152 with Not_found -> ())
155 let open_formatter fname =
156 Unix.open_process_out (Printf.sprintf "xmllint --format -o %s -" fname)
158 let close_formatter oc = ignore (Unix.close_process_out oc)
160 let output_index (titlepage: 'a node) (toc: 'a node) fname =
161 let oc = open_formatter fname in
162 output_string oc xhtml_header;
163 titlepage#write (`Out_channel oc) `Enc_utf8;
164 toc#write (`Out_channel oc) `Enc_utf8;
165 output_string oc xhtml_trailer;
168 let output_sec (sec: 'a node) fname =
169 let oc = open_formatter fname in
170 output_string oc xhtml_header;
171 sec#write (`Out_channel oc) `Enc_utf8;
172 output_string oc xhtml_trailer;
176 let doc = parse_xml fname in
178 | titlepage :: toc :: secs ->
179 let sec_ids, id2sec = localize_ids secs in
180 patch_toc sec_ids id2sec toc;
181 List.iter (patch_sec sec_ids id2sec) secs;
182 output_index titlepage toc "index.html";
183 List.iter (fun sec -> output_sec sec (get_sec_name sec ^ ".html")) secs
184 | _ -> failwith "Unrecognized document structure"