File: main.ml

package info (click to toggle)
pxp 1.2.9-4
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 7,844 kB
  • sloc: ml: 28,666; xml: 2,597; makefile: 822; sh: 691
file content (513 lines) | stat: -rw-r--r-- 13,716 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
(* $Id$
 * ----------------------------------------------------------------------
 *
 *)


(* Convert XHTML-1.0 document into HTML-4.01 document. The input is parsed
 * in well-formedness mode, and is not validated. The input should have one
 * of these DOCTYPEs:
 * - PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
 * - PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 * - PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
 *
 * The input must declare the HTML namespace as http://www.w3.org/1999/xhtml.
 *
 * The XHTML entity sets (Latin 1, Special, Symbol) can be assumed.
 * In output, always numeric entities are printed.
 *
 * Processing instructions and comments are removed from the document.
 *
 * Output encoding is 7 bit ASCII.
 *
 * TODO:
 * - id/name: These attributes are not yet checked, but simply printed as
 *   found in the input
 * - XML stylesheets are not yet transformed to HTML stylesheets
 *   (conversion of <?xml-stylesheet ...?> to <style ...>)
 *)

open Pxp_tree_parser;;
open Pxp_types;;
open Pxp_document;;

type html_doctype =
  [ `Frameset
  | `Transitional
  | `Strict
  ]
;;


(**********************************************************************)
(* XHTML entities                                                     *)
(**********************************************************************)

let xhtml_lat1_ent = "<?xml version='1.0' encoding='UTF-8'?>
<!ENTITY nbsp   '&#160;'>
<!ENTITY iexcl  '&#161;'>
<!ENTITY cent   '&#162;'>
<!ENTITY pound  '&#163;'>
<!ENTITY curren '&#164;'>
<!ENTITY yen    '&#165;'>
<!ENTITY brvbar '&#166;'>
<!ENTITY sect   '&#167;'>
<!ENTITY uml    '&#168;'>
<!ENTITY copy   '&#169;'>
<!ENTITY ordf   '&#170;'>
<!ENTITY laquo  '&#171;'>
<!ENTITY not    '&#172;'>
<!ENTITY shy    '&#173;'>
<!ENTITY reg    '&#174;'>
<!ENTITY macr   '&#175;'>
<!ENTITY deg    '&#176;'>
<!ENTITY plusmn '&#177;'>
<!ENTITY sup2   '&#178;'>
<!ENTITY sup3   '&#179;'>
<!ENTITY acute  '&#180;'>
<!ENTITY micro  '&#181;'>
<!ENTITY para   '&#182;'>
<!ENTITY middot '&#183;'>
<!ENTITY cedil  '&#184;'>
<!ENTITY sup1   '&#185;'>
<!ENTITY ordm   '&#186;'>
<!ENTITY raquo  '&#187;'>
<!ENTITY frac14 '&#188;'>
<!ENTITY frac12 '&#189;'>
<!ENTITY frac34 '&#190;'>
<!ENTITY iquest '&#191;'>
<!ENTITY Agrave '&#192;'>
<!ENTITY Aacute '&#193;'>
<!ENTITY Acirc  '&#194;'>
<!ENTITY Atilde '&#195;'>
<!ENTITY Auml   '&#196;'>
<!ENTITY Aring  '&#197;'>
<!ENTITY AElig  '&#198;'>
<!ENTITY Ccedil '&#199;'>
<!ENTITY Egrave '&#200;'>
<!ENTITY Eacute '&#201;'>
<!ENTITY Ecirc  '&#202;'>
<!ENTITY Euml   '&#203;'>
<!ENTITY Igrave '&#204;'>
<!ENTITY Iacute '&#205;'>
<!ENTITY Icirc  '&#206;'>
<!ENTITY Iuml   '&#207;'>
<!ENTITY ETH    '&#208;'>
<!ENTITY Ntilde '&#209;'>
<!ENTITY Ograve '&#210;'>
<!ENTITY Oacute '&#211;'>
<!ENTITY Ocirc  '&#212;'>
<!ENTITY Otilde '&#213;'>
<!ENTITY Ouml   '&#214;'>
<!ENTITY times  '&#215;'>
<!ENTITY Oslash '&#216;'>
<!ENTITY Ugrave '&#217;'>
<!ENTITY Uacute '&#218;'>
<!ENTITY Ucirc  '&#219;'>
<!ENTITY Uuml   '&#220;'>
<!ENTITY Yacute '&#221;'>
<!ENTITY THORN  '&#222;'>
<!ENTITY szlig  '&#223;'>
<!ENTITY agrave '&#224;'>
<!ENTITY aacute '&#225;'>
<!ENTITY acirc  '&#226;'>
<!ENTITY atilde '&#227;'>
<!ENTITY auml   '&#228;'>
<!ENTITY aring  '&#229;'>
<!ENTITY aelig  '&#230;'>
<!ENTITY ccedil '&#231;'>
<!ENTITY egrave '&#232;'>
<!ENTITY eacute '&#233;'>
<!ENTITY ecirc  '&#234;'>
<!ENTITY euml   '&#235;'>
<!ENTITY igrave '&#236;'>
<!ENTITY iacute '&#237;'>
<!ENTITY icirc  '&#238;'>
<!ENTITY iuml   '&#239;'>
<!ENTITY eth    '&#240;'>
<!ENTITY ntilde '&#241;'>
<!ENTITY ograve '&#242;'>
<!ENTITY oacute '&#243;'>
<!ENTITY ocirc  '&#244;'>
<!ENTITY otilde '&#245;'>
<!ENTITY ouml   '&#246;'>
<!ENTITY divide '&#247;'>
<!ENTITY oslash '&#248;'>
<!ENTITY ugrave '&#249;'>
<!ENTITY uacute '&#250;'>
<!ENTITY ucirc  '&#251;'>
<!ENTITY uuml   '&#252;'>
<!ENTITY yacute '&#253;'>
<!ENTITY thorn  '&#254;'>
<!ENTITY yuml   '&#255;'>"
;;


let xhtml_special_ent = "<?xml version='1.0' encoding='UTF-8'?>
<!ENTITY OElig   '&#338;'>
<!ENTITY oelig   '&#339;'>
<!ENTITY Scaron  '&#352;'>
<!ENTITY scaron  '&#353;'>
<!ENTITY Yuml    '&#376;'>
<!ENTITY circ    '&#710;'>
<!ENTITY tilde   '&#732;'>
<!ENTITY ensp    '&#8194;'>
<!ENTITY emsp    '&#8195;'>
<!ENTITY thinsp  '&#8201;'>
<!ENTITY zwnj    '&#8204;'>
<!ENTITY zwj     '&#8205;'>
<!ENTITY lrm     '&#8206;'>
<!ENTITY rlm     '&#8207;'>
<!ENTITY ndash   '&#8211;'>
<!ENTITY mdash   '&#8212;'>
<!ENTITY lsquo   '&#8216;'>
<!ENTITY rsquo   '&#8217;'>
<!ENTITY sbquo   '&#8218;'>
<!ENTITY ldquo   '&#8220;'>
<!ENTITY rdquo   '&#8221;'>
<!ENTITY bdquo   '&#8222;'>
<!ENTITY dagger  '&#8224;'>
<!ENTITY Dagger  '&#8225;'>
<!ENTITY permil  '&#8240;'>
<!ENTITY lsaquo  '&#8249;'>
<!ENTITY rsaquo  '&#8250;'>
<!ENTITY euro   '&#8364;'>"
;;


let xhtml_symbol_ent = "<?xml version='1.0' encoding='UTF-8'?>
<!ENTITY fnof     '&#402;'>
<!ENTITY Alpha    '&#913;'>
<!ENTITY Beta     '&#914;'>
<!ENTITY Gamma    '&#915;'>
<!ENTITY Delta    '&#916;'>
<!ENTITY Epsilon  '&#917;'>
<!ENTITY Zeta     '&#918;'>
<!ENTITY Eta      '&#919;'>
<!ENTITY Theta    '&#920;'>
<!ENTITY Iota     '&#921;'>
<!ENTITY Kappa    '&#922;'>
<!ENTITY Lambda   '&#923;'>
<!ENTITY Mu       '&#924;'>
<!ENTITY Nu       '&#925;'>
<!ENTITY Xi       '&#926;'>
<!ENTITY Omicron  '&#927;'>
<!ENTITY Pi       '&#928;'>
<!ENTITY Rho      '&#929;'>
<!ENTITY Sigma    '&#931;'>
<!ENTITY Tau      '&#932;'>
<!ENTITY Upsilon  '&#933;'>
<!ENTITY Phi      '&#934;'>
<!ENTITY Chi      '&#935;'>
<!ENTITY Psi      '&#936;'>
<!ENTITY Omega    '&#937;'>
<!ENTITY alpha    '&#945;'>
<!ENTITY beta     '&#946;'>
<!ENTITY gamma    '&#947;'>
<!ENTITY delta    '&#948;'>
<!ENTITY epsilon  '&#949;'>
<!ENTITY zeta     '&#950;'>
<!ENTITY eta      '&#951;'>
<!ENTITY theta    '&#952;'>
<!ENTITY iota     '&#953;'>
<!ENTITY kappa    '&#954;'>
<!ENTITY lambda   '&#955;'>
<!ENTITY mu       '&#956;'>
<!ENTITY nu       '&#957;'>
<!ENTITY xi       '&#958;'>
<!ENTITY omicron  '&#959;'>
<!ENTITY pi       '&#960;'>
<!ENTITY rho      '&#961;'>
<!ENTITY sigmaf   '&#962;'>
<!ENTITY sigma    '&#963;'>
<!ENTITY tau      '&#964;'>
<!ENTITY upsilon  '&#965;'>
<!ENTITY phi      '&#966;'>
<!ENTITY chi      '&#967;'>
<!ENTITY psi      '&#968;'>
<!ENTITY omega    '&#969;'>
<!ENTITY thetasym '&#977;'>
<!ENTITY upsih    '&#978;'>
<!ENTITY piv      '&#982;'>
<!ENTITY bull     '&#8226;'>
<!ENTITY hellip   '&#8230;'>
<!ENTITY prime    '&#8242;'>
<!ENTITY Prime    '&#8243;'>
<!ENTITY oline    '&#8254;'>
<!ENTITY frasl    '&#8260;'>
<!ENTITY weierp   '&#8472;'>
<!ENTITY image    '&#8465;'>
<!ENTITY real     '&#8476;'>
<!ENTITY trade    '&#8482;'>
<!ENTITY alefsym  '&#8501;'>
<!ENTITY larr     '&#8592;'>
<!ENTITY uarr     '&#8593;'>
<!ENTITY rarr     '&#8594;'>
<!ENTITY darr     '&#8595;'>
<!ENTITY harr     '&#8596;'>
<!ENTITY crarr    '&#8629;'>
<!ENTITY lArr     '&#8656;'>
<!ENTITY uArr     '&#8657;'>
<!ENTITY rArr     '&#8658;'>
<!ENTITY dArr     '&#8659;'>
<!ENTITY hArr     '&#8660;'>
<!ENTITY forall   '&#8704;'>
<!ENTITY part     '&#8706;'>
<!ENTITY exist    '&#8707;'>
<!ENTITY empty    '&#8709;'>
<!ENTITY nabla    '&#8711;'>
<!ENTITY isin     '&#8712;'>
<!ENTITY notin    '&#8713;'>
<!ENTITY ni       '&#8715;'>
<!ENTITY prod     '&#8719;'>
<!ENTITY sum      '&#8721;'>
<!ENTITY minus    '&#8722;'>
<!ENTITY lowast   '&#8727;'>
<!ENTITY radic    '&#8730;'>
<!ENTITY prop     '&#8733;'>
<!ENTITY infin    '&#8734;'>
<!ENTITY ang      '&#8736;'>
<!ENTITY and      '&#8743;'>
<!ENTITY or       '&#8744;'>
<!ENTITY cap      '&#8745;'>
<!ENTITY cup      '&#8746;'>
<!ENTITY int      '&#8747;'>
<!ENTITY there4   '&#8756;'>
<!ENTITY sim      '&#8764;'>
<!ENTITY cong     '&#8773;'>
<!ENTITY asymp    '&#8776;'>
<!ENTITY ne       '&#8800;'>
<!ENTITY equiv    '&#8801;'>
<!ENTITY le       '&#8804;'>
<!ENTITY ge       '&#8805;'>
<!ENTITY sub      '&#8834;'>
<!ENTITY sup      '&#8835;'>
<!ENTITY nsub     '&#8836;'>
<!ENTITY sube     '&#8838;'>
<!ENTITY supe     '&#8839;'>
<!ENTITY oplus    '&#8853;'>
<!ENTITY otimes   '&#8855;'>
<!ENTITY perp     '&#8869;'>
<!ENTITY sdot     '&#8901;'>
<!ENTITY lceil    '&#8968;'>
<!ENTITY rceil    '&#8969;'>
<!ENTITY lfloor   '&#8970;'>
<!ENTITY rfloor   '&#8971;'>
<!ENTITY lang     '&#9001;'>
<!ENTITY rang     '&#9002;'>
<!ENTITY loz      '&#9674;'>
<!ENTITY spades   '&#9824;'>
<!ENTITY clubs    '&#9827;'>
<!ENTITY hearts   '&#9829;'>
<!ENTITY diams    '&#9830;'>"
;;


let xhtml_doctype = "<?xml version='1.0' encoding='UTF-8'?>
<!ENTITY % HTMLlat1 PUBLIC '-//W3C//ENTITIES Latin 1 for XHTML//EN' ''>
<!ENTITY % HTMLspecial PUBLIC '-//W3C//ENTITIES Special for XHTML//EN' ''>
<!ENTITY % HTMLsymbol PUBLIC '-//W3C//ENTITIES Symbols for XHTML//EN' ''>
%HTMLlat1;
%HTMLspecial;
%HTMLsymbol;"
;;
  

let parse filename =
  let namespace_manager = new Pxp_dtd.namespace_manager in
  namespace_manager # add_namespace "html" "http://www.w3.org/1999/xhtml";
  (* Force that internally the namespace prefix "html" is used for html
   * namespace. PXP converts the namespace prefixes found in the input
   * document to "html".
   *)

  let catalog =
    Pxp_reader.lookup_public_id_as_string
      [ "-//W3C//ENTITIES Latin 1 for XHTML//EN", xhtml_lat1_ent;
	"-//W3C//ENTITIES Special for XHTML//EN", xhtml_special_ent;
	"-//W3C//ENTITIES Symbols for XHTML//EN", xhtml_symbol_ent;
	"-//W3C//DTD XHTML 1.0 Strict//EN", xhtml_doctype;
	"-//W3C//DTD XHTML 1.0 Transitional//EN", xhtml_doctype;
	"-//W3C//DTD XHTML 1.0 Frameset//EN", xhtml_doctype;
      ]
  in

  let reader = 
    new Pxp_reader.combine
      [ new Pxp_reader.resolve_as_file();
	catalog;
      ]
  in

  let config = 
    { default_namespace_config with
	encoding = `Enc_utf8;
	enable_namespace_processing = Some namespace_manager;
    } in

  let filename_url = Pxp_reader.make_file_url filename in
  let filename_url_string = Neturl.string_of_url filename_url in

  parse_wfdocument_entity
    config
    (ExtID ((System filename_url_string), reader))
    default_namespace_spec
;;


let recognize_xhtml_doctype doc =
  match doc # dtd # id with
      Some(External(Public("-//W3C//DTD XHTML 1.0 Strict//EN",_))) ->
	`Strict
    | Some(Derived(Public("-//W3C//DTD XHTML 1.0 Strict//EN",_))) ->
	`Strict
    | Some(External(Public("-//W3C//DTD XHTML 1.0 Transitional//EN",_))) ->
	`Transitional
    | Some(Derived(Public("-//W3C//DTD XHTML 1.0 Transitional//EN",_))) ->
	`Transitional
    | Some(External(Public("-//W3C//DTD XHTML 1.0 Frameset//EN",_))) ->
	`Frameset
    | Some(Derived(Public("-//W3C//DTD XHTML 1.0 Frameset//EN",_))) ->
	`Frameset
    | _ ->
	prerr_endline("Warning: DOCTYPE not recognized, assuming HTML-4.01-transitional");
	`Transitional   (* Just a default... *)
;;


let html401_doctype_string =
  [ `Frameset, 
    "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" \"http://www.w3.org/TR/html4/frameset.dtd\">";

    `Transitional,
    "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">";

    `Strict,
    "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">";
  ]
;;


let element_declared_as_empty name =
  try
    snd(List.assoc name Nethtml.html40_dtd) = `Empty
  with
      Not_found -> false
;;


let convert_and_print ?(remove = "") (doc : 'ext document) =
  (* Only "html" prefix elements are printed, other namespaces are dropped.
   * 
   *)

  let escape_html =
    let in_enc = `Enc_utf8 in
    let out_enc = `Enc_subset(`Enc_usascii, 
			      function
				  64 -> false   (* Anti-SPAM *)
				| 58 -> false   (* Anti-SPAM *)
				| _ -> true) in
    Netencoding.Html.encode ~in_enc ~out_enc ~prefer_name:false () in

  let print_data s =
    print_string (escape_html s)
  in

  let print_url s =
    let p = String.length remove in
    let l = String.length s in
    if p < l & String.sub s 0 p = remove then
      print_data(String.sub s p (l-p))
    else
      print_data s
  in

  let rec print_attlist (node : 'ext node) =
    List.iter
      (fun (name,value) ->
	 print_string name;
	 print_string "=\"";
	 ( match value with
	       Value s -> 
		 if name="href" || name="src" then
		   print_url s 
		 else
		   print_data s
	     | _ -> assert false
		 (* Impossible in wf mode *)
	 );
	 print_string "\" ";
      )
      node#attributes
  in

  let rec print (node : 'ext node) =
    match node # node_type with
	T_element _ ->
	  if node # normprefix = "html" then begin
	    let htmlname = node # localname in
	    let empty = element_declared_as_empty htmlname in
	    print_string "<";
	    print_string htmlname;
	    print_string " ";
	    print_attlist node;
	    print_string ">";
	    node # iter_nodes print;
	    if not empty then begin
	      print_string "</";
	      print_string htmlname;
	      print_string ">";
	    end
	  end
      | T_data ->
	  print_data node#data
      | _ ->
	  ()
	  (* Drop... *)
  in

  (* Detect DOCTYPE: *)
  let html_doctype = recognize_xhtml_doctype doc in

  (* Print DOCTYPE: *)
  let doctype_string = List.assoc html_doctype html401_doctype_string in
  print_endline doctype_string;

  (* Convert and print document: *)
  print doc#root;

  print_newline();

  flush stdout
;;


let main() =
  let file = ref "" in
  let remove = ref "" in
  Arg.parse 
      [ "-remove", Arg.String (fun s -> remove := s),
                "<prefix>   Remove this prefix from all URLs";
      ]
      (fun s -> file := s)
      "Usage: xhtml2html file.xml >file.html";

  if !file = "" then 
    failwith "No input file! See xhtml2html -help for usage information.";

  let doc = parse !file in
  convert_and_print ~remove:!remove doc
;;


try
  main()
with
    error ->
      prerr_endline("*** xhtml2html stopped:");
      prerr_endline(Pxp_types.string_of_exn error);
      exit 1
;;