[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s... |
|
Date: |
Thu, 26 Jan 2006 10:40:03 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Branch:
Changes by: spiralvoice <address@hidden> 06/01/26 10:40:02
Modified files:
config : Makefile.in
distrib : ChangeLog
src/utils/ocamlrss: rss.ml rss.mli rss_io.ml rss_messages.ml
rss_types.ml
src/utils/xml-light: xml.ml xmlParser.ml xml_dtd.ml xml_dtd.mli
xml_lexer.mli xml_lexer.mll xml_types.ml
Log message:
patch #4816
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/config/Makefile.in.diff?tr1=1.143&tr2=1.144&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/distrib/ChangeLog.diff?tr1=1.687&tr2=1.688&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/ocamlrss/rss.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/ocamlrss/rss.mli.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/ocamlrss/rss_io.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/ocamlrss/rss_messages.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/ocamlrss/rss_types.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/xml-light/xml.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/xml-light/xmlParser.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/xml-light/xml_dtd.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/xml-light/xml_dtd.mli.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/xml-light/xml_lexer.mli.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/xml-light/xml_lexer.mll.diff?tr1=1.2&tr2=1.3&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/xml-light/xml_types.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
Patches:
Index: mldonkey/config/Makefile.in
diff -u mldonkey/config/Makefile.in:1.143 mldonkey/config/Makefile.in:1.144
--- mldonkey/config/Makefile.in:1.143 Thu Jan 26 00:25:24 2006
+++ mldonkey/config/Makefile.in Thu Jan 26 10:39:59 2006
@@ -1677,8 +1677,8 @@
rm -f build/*.a build/*.cma build/*.cmxa
rm -f *_plugin
rm -f mldonkey mlgui mlnet.exe mlgui.exe mldonkeytop mldonkeytop.exe
- rm -f svg_converter svg_converter.byte mld_hash make_torrent
copysources get_range subconv dp500
- rm -f svg_converter.exe mld_hash.exe make_torrent.exe copysources.exe
get_range.exe subconv.exe dp500.exe
+ rm -f svg_converter svg_converter.byte mld_hash make_torrent
copysources get_range subconv dp500 testrss
+ rm -f svg_converter.exe mld_hash.exe make_torrent.exe copysources.exe
get_range.exe subconv.exe dp500.exe testrss.exe
(for i in $(SUBDIRS); do \
rm -f $$i/*.cm? $$i/*.o $$i/*.annot ; \
done)
Index: mldonkey/distrib/ChangeLog
diff -u mldonkey/distrib/ChangeLog:1.687 mldonkey/distrib/ChangeLog:1.688
--- mldonkey/distrib/ChangeLog:1.687 Thu Jan 26 10:34:51 2006
+++ mldonkey/distrib/ChangeLog Thu Jan 26 10:40:00 2006
@@ -15,6 +15,7 @@
=========
2006/01/26
+4816: Update Ocaml-RSS and Xml-light to current versions
4827: longhelp cleanup (anhi)
4823: EDK: CryptoPP optional, disable with --disable-donkeysui
Makefile: link CryptoPP stuff only in binaries which need it
Index: mldonkey/src/utils/ocamlrss/rss.ml
diff -u mldonkey/src/utils/ocamlrss/rss.ml:1.1
mldonkey/src/utils/ocamlrss/rss.ml:1.2
--- mldonkey/src/utils/ocamlrss/rss.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/ocamlrss/rss.ml Thu Jan 26 10:40:01 2006
@@ -35,84 +35,85 @@
let since_epoch = Rss_date.since_epoch
let float_to_date t = Rss_date.create t
+let string_of_date ?(fmt="%d %b %Y") date = Rss_date.format ~fmt date
type email = string (** can be, for example: address@hidden (Mr Foo Bar) *)
type url = string
type category = Rss_types.category =
{
- cat_name : string ;
- cat_domain : url option ;
+ mutable cat_name : string ;
+ mutable cat_domain : url option ;
}
type image = Rss_types.image =
{
- image_url : url ;
- image_title : string ;
- image_link : url ;
- image_height : int option ;
- image_width : int option ;
- image_desc : string option ;
+ mutable image_url : url ;
+ mutable image_title : string ;
+ mutable image_link : url ;
+ mutable image_height : int option ;
+ mutable image_width : int option ;
+ mutable image_desc : string option ;
}
type text_input = Rss_types.text_input =
{
- ti_title : string ; (** The label of the Submit button in the text input
area. *)
- ti_desc : string ; (** Explains the text input area. *)
- ti_name : string ; (** The name of the text object in the text input
area. *)
- ti_link : string ; (** The URL of the CGI script that processes text
input requests. *)
+ mutable ti_title : string ; (** The label of the Submit button in the
text input area. *)
+ mutable ti_desc : string ; (** Explains the text input area. *)
+ mutable ti_name : string ; (** The name of the text object in the text
input area. *)
+ mutable ti_link : string ; (** The URL of the CGI script that processes
text input requests. *)
}
type enclosure = Rss_types.enclosure =
{
- encl_url : url ; (** URL of the enclosure *)
- encl_length : int ; (** size in bytes *)
- encl_type : string ; (** MIME type *)
+ mutable encl_url : url ; (** URL of the enclosure *)
+ mutable encl_length : int ; (** size in bytes *)
+ mutable encl_type : string ; (** MIME type *)
}
type guid = Rss_types.guid =
{
- guid_name : string ; (** can be a permanent url, if permalink is true *)
- guid_permalink : bool ; (** default is true when no value was specified
*)
+ mutable guid_name : string ; (** can be a permanent url, if permalink is
true *)
+ mutable guid_permalink : bool ; (** default is true when no value was
specified *)
}
type source = Rss_types.source =
{
- src_name : string ;
- src_url : url ;
+ mutable src_name : string ;
+ mutable src_url : url ;
}
type item = Rss_types.item =
{
- item_title : string option;
- item_link : url option;
- item_desc : string option;
- item_pubdate : date option ;
- item_author : email option ;
- item_categories : category list ;
- item_comments : url option ;
- item_enclosure : enclosure option ;
- item_guid : guid option ;
- item_source : source option ;
+ mutable item_title : string option;
+ mutable item_link : url option;
+ mutable item_desc : string option;
+ mutable item_pubdate : date option ;
+ mutable item_author : email option ;
+ mutable item_categories : category list ;
+ mutable item_comments : url option ;
+ mutable item_enclosure : enclosure option ;
+ mutable item_guid : guid option ;
+ mutable item_source : source option ;
}
type channel = Rss_types.channel =
{
- ch_title : string ;
- ch_link : url ;
- ch_desc : string ;
- ch_language : string option ;
- ch_copyright : string option ;
- ch_managing_editor : email option ;
- ch_webmaster : email option ;
- ch_pubdate : date option ;
- ch_last_build_date : date option ;
- ch_categories : category list ;
- ch_generator : string option ;
- ch_docs : url option ;
- ch_ttl : int option ;
- ch_image : image option ;
- ch_text_input : text_input option ;
- ch_items : item list ;
+ mutable ch_title : string ;
+ mutable ch_link : url ;
+ mutable ch_desc : string ;
+ mutable ch_language : string option ;
+ mutable ch_copyright : string option ;
+ mutable ch_managing_editor : email option ;
+ mutable ch_webmaster : email option ;
+ mutable ch_pubdate : date option ;
+ mutable ch_last_build_date : date option ;
+ mutable ch_categories : category list ;
+ mutable ch_generator : string option ;
+ mutable ch_docs : url option ;
+ mutable ch_ttl : int option ;
+ mutable ch_image : image option ;
+ mutable ch_text_input : text_input option ;
+ mutable ch_items : item list ;
}
let item ?title
@@ -179,9 +180,9 @@
let print_channel = Rss_io.print_channel
-let print_file file ch =
+let print_file ?date_fmt file ch =
let oc = open_out file in
let fmt = Format.formatter_of_out_channel oc in
- print_channel fmt ch;
+ print_channel ?date_fmt fmt ch;
Format.pp_print_flush fmt ();
close_out oc
Index: mldonkey/src/utils/ocamlrss/rss.mli
diff -u mldonkey/src/utils/ocamlrss/rss.mli:1.1
mldonkey/src/utils/ocamlrss/rss.mli:1.2
--- mldonkey/src/utils/ocamlrss/rss.mli:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/ocamlrss/rss.mli Thu Jan 26 10:40:01 2006
@@ -39,85 +39,85 @@
val since_epoch : date -> float
val float_to_date : float -> date
-
+val string_of_date : ?fmt: string -> date -> string
type email = string (** can be, for example: address@hidden (Mr Foo Bar) *)
type url = string
type category =
{
- cat_name : string ;
- cat_domain : url option ;
+ mutable cat_name : string ;
+ mutable cat_domain : url option ;
}
type image =
{
- image_url : url ;
- image_title : string ;
- image_link : url ;
- image_height : int option ;
- image_width : int option ;
- image_desc : string option ;
+ mutable image_url : url ;
+ mutable image_title : string ;
+ mutable image_link : url ;
+ mutable image_height : int option ;
+ mutable image_width : int option ;
+ mutable image_desc : string option ;
}
type text_input =
{
- ti_title : string ; (** The label of the Submit button in the text input
area. *)
- ti_desc : string ; (** Explains the text input area. *)
- ti_name : string ; (** The name of the text object in the text input
area. *)
- ti_link : string ; (** The URL of the CGI script that processes text
input requests. *)
+ mutable ti_title : string ; (** The label of the Submit button in the
text input area. *)
+ mutable ti_desc : string ; (** Explains the text input area. *)
+ mutable ti_name : string ; (** The name of the text object in the text
input area. *)
+ mutable ti_link : string ; (** The URL of the CGI script that processes
text input requests. *)
}
type enclosure =
{
- encl_url : url ; (** URL of the enclosure *)
- encl_length : int ; (** size in bytes *)
- encl_type : string ; (** MIME type *)
+ mutable encl_url : url ; (** URL of the enclosure *)
+ mutable encl_length : int ; (** size in bytes *)
+ mutable encl_type : string ; (** MIME type *)
}
type guid =
{
- guid_name : string ; (** can be a permanent url, if permalink is true *)
- guid_permalink : bool ; (** default is true when no value was specified
*)
+ mutable guid_name : string ; (** can be a permanent url, if permalink is
true *)
+ mutable guid_permalink : bool ; (** default is true when no value was
specified *)
}
type source =
{
- src_name : string ;
- src_url : url ;
+ mutable src_name : string ;
+ mutable src_url : url ;
}
type item =
{
- item_title : string option; (** Optional title *)
- item_link : url option; (** Optional link *)
- item_desc : string option; (** Optional description *)
- item_pubdate : date option ; (** Date of publication *)
- item_author : email option ; (** Author of the item *)
- item_categories : category list ;
- item_comments : url option ; (** Url of comments about this item *)
- item_enclosure : enclosure option ;
- item_guid : guid option ;
- item_source : source option ;
+ mutable item_title : string option; (** Optional title *)
+ mutable item_link : url option; (** Optional link *)
+ mutable item_desc : string option; (** Optional description *)
+ mutable item_pubdate : date option ; (** Date of publication *)
+ mutable item_author : email option ; (** Author of the item *)
+ mutable item_categories : category list ;
+ mutable item_comments : url option ; (** Url of comments about this item
*)
+ mutable item_enclosure : enclosure option ;
+ mutable item_guid : guid option ;
+ mutable item_source : source option ;
}
type channel =
{
- ch_title : string ; (** Mandatory title *)
- ch_link : url ; (** Mandatory link of the site *)
- ch_desc : string ; (** Mandatory description *)
- ch_language : string option ; (** Language of the news *)
- ch_copyright : string option ; (** Copyright note *)
- ch_managing_editor : email option ; (** Managing editor of the news *)
- ch_webmaster : email option ; (** The webmasterof the site *)
- ch_pubdate : date option ; (** Publication date of the channel *)
- ch_last_build_date : date option ; (** When the channel was last built *)
- ch_categories : category list ;
- ch_generator : string option ; (** The tool used to generate this
channel *)
- ch_docs : url option ; (** An url to a RSS reference *)
- ch_ttl : int option ; (** Time to live, in minutes *)
- ch_image : image option ;
- ch_text_input : text_input option ;
- ch_items : item list ;
+ mutable ch_title : string ; (** Mandatory title *)
+ mutable ch_link : url ; (** Mandatory link of the site *)
+ mutable ch_desc : string ; (** Mandatory description *)
+ mutable ch_language : string option ; (** Language of the news *)
+ mutable ch_copyright : string option ; (** Copyright note *)
+ mutable ch_managing_editor : email option ; (** Managing editor of the
news *)
+ mutable ch_webmaster : email option ; (** The webmasterof the site *)
+ mutable ch_pubdate : date option ; (** Publication date of the channel *)
+ mutable ch_last_build_date : date option ; (** When the channel was last
built *)
+ mutable ch_categories : category list ;
+ mutable ch_generator : string option ; (** The tool used to generate
this channel *)
+ mutable ch_docs : url option ; (** An url to a RSS reference *)
+ mutable ch_ttl : int option ; (** Time to live, in minutes *)
+ mutable ch_image : image option ;
+ mutable ch_text_input : text_input option ;
+ mutable ch_items : item list ;
}
(** {2 Building items and channels} *)
@@ -162,5 +162,5 @@
(** {2 Writing channels} *)
-val print_channel : Format.formatter -> channel -> unit
-val print_file : string -> channel -> unit
+val print_channel : ?date_fmt: string -> Format.formatter -> channel -> unit
+val print_file : ?date_fmt: string -> string -> channel -> unit
Index: mldonkey/src/utils/ocamlrss/rss_io.ml
diff -u mldonkey/src/utils/ocamlrss/rss_io.ml:1.1
mldonkey/src/utils/ocamlrss/rss_io.ml:1.2
--- mldonkey/src/utils/ocamlrss/rss_io.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/ocamlrss/rss_io.ml Thu Jan 26 10:40:01 2006
@@ -399,7 +399,7 @@
let xmls_of_text_input_opt = xmls_of_opt_f xml_of_text_input
-let xml_of_item i =
+let xml_of_item ~date_fmt i =
Element ("item", [],
(List.flatten
[ opt_element i.item_title "title" ;
@@ -410,7 +410,7 @@
None -> None
| Some d ->
err_date d;
- Some (Rss_date.format ~fmt: default_date_format d))
+ Some (Rss_date.format ~fmt: date_fmt d))
"pubDate" ;
opt_element i.item_author "author" ;
xmls_of_categories i.item_categories ;
@@ -422,7 +422,7 @@
)
)
-let xml_of_channel ch =
+let xml_of_channel ~date_fmt ch =
let f v s = Element (s, [], [PCData v]) in
let xml_ch =
Element ("channel", [],
@@ -441,14 +441,14 @@
None -> None
| Some d ->
err_date d ;
- Some (Rss_date.format ~fmt: default_date_format d))
+ Some (Rss_date.format ~fmt: date_fmt d))
"pubDate" ;
opt_element
(match ch.ch_last_build_date with
None -> None
| Some d ->
err_date d ;
- Some (Rss_date.format ~fmt: default_date_format d))
+ Some (Rss_date.format ~fmt: date_fmt d))
"lastBuildDate" ;
xmls_of_categories ch.ch_categories ;
opt_element ch.ch_generator "generator" ;
@@ -458,7 +458,7 @@
"ttl";
xmls_of_image_opt ch.ch_image ;
xmls_of_text_input_opt ch.ch_text_input ;
- List.map xml_of_item ch.ch_items ;
+ List.map (xml_of_item ~date_fmt) ch.ch_items ;
]
)
)
@@ -466,7 +466,8 @@
in
Element ("rss", ["version", "2.0"], [xml_ch])
-let print_channel fmt ch =
- let xml = xml_of_channel ch in
+
+let print_channel ?(date_fmt=default_date_format) fmt ch =
+ let xml = xml_of_channel ~date_fmt ch in
Format.fprintf fmt "<?xml version=\"1.0\" encoding=\"ISO-8859-1\" ?>\n";
Format.fprintf fmt "%s" (Xml.to_string_fmt xml )
Index: mldonkey/src/utils/ocamlrss/rss_messages.ml
diff -u mldonkey/src/utils/ocamlrss/rss_messages.ml:1.1
mldonkey/src/utils/ocamlrss/rss_messages.ml:1.2
--- mldonkey/src/utils/ocamlrss/rss_messages.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/ocamlrss/rss_messages.ml Thu Jan 26 10:40:01 2006
@@ -25,7 +25,7 @@
(** Messages and string constants. *)
let software = "ocaml-rss"
-let software_version = "0.1"
+let software_version = "0.4"
(** {2 Messages} *)
Index: mldonkey/src/utils/ocamlrss/rss_types.ml
diff -u mldonkey/src/utils/ocamlrss/rss_types.ml:1.1
mldonkey/src/utils/ocamlrss/rss_types.ml:1.2
--- mldonkey/src/utils/ocamlrss/rss_types.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/ocamlrss/rss_types.ml Thu Jan 26 10:40:01 2006
@@ -28,33 +28,33 @@
type category =
{
- cat_name : string ;
- cat_domain : url option ;
+ mutable cat_name : string ;
+ mutable cat_domain : url option ;
}
type image =
{
- image_url : url ;
- image_title : string ;
- image_link : url ;
- image_height : int option ;
- image_width : int option ;
- image_desc : string option ;
+ mutable image_url : url ;
+ mutable image_title : string ;
+ mutable image_link : url ;
+ mutable image_height : int option ;
+ mutable image_width : int option ;
+ mutable image_desc : string option ;
}
type text_input =
{
- ti_title : string ; (** The label of the Submit button in the text input
area. *)
- ti_desc : string ; (** Explains the text input area. *)
- ti_name : string ; (** The name of the text object in the text input
area. *)
- ti_link : string ; (** The URL of the CGI script that processes text
input requests. *)
+ mutable ti_title : string ; (** The label of the Submit button in the
text input area. *)
+ mutable ti_desc : string ; (** Explains the text input area. *)
+ mutable ti_name : string ; (** The name of the text object in the text
input area. *)
+ mutable ti_link : string ; (** The URL of the CGI script that processes
text input requests. *)
}
type enclosure =
{
- encl_url : url ; (** URL of the enclosure *)
- encl_length : int ; (** size in bytes *)
- encl_type : string ; (** MIME type *)
+ mutable encl_url : url ; (** URL of the enclosure *)
+ mutable encl_length : int ; (** size in bytes *)
+ mutable encl_type : string ; (** MIME type *)
}
type cloud = int (* A VOIR *)
@@ -71,53 +71,52 @@
type guid =
{
- guid_name : string ; (** can be a permanent url, if permalink is true *)
- guid_permalink : bool ; (** default is true when no value was specified
*)
+ mutable guid_name : string ; (** can be a permanent url, if permalink is
true *)
+ mutable guid_permalink : bool ; (** default is true when no value was
specified *)
}
type source =
{
- src_name : string ;
- src_url : url ;
+ mutable src_name : string ;
+ mutable src_url : url ;
}
type item =
{
- item_title : string option ;
- item_link : url option ;
- item_desc : string option ;
- item_pubdate : Rss_date.t option ;
- item_author : email option ;
- item_categories : category list ;
- item_comments : url option ;
- item_enclosure : enclosure option ;
- item_guid : guid option ;
- item_source : source option ;
+ mutable item_title : string option ;
+ mutable item_link : url option ;
+ mutable item_desc : string option ;
+ mutable item_pubdate : Rss_date.t option ;
+ mutable item_author : email option ;
+ mutable item_categories : category list ;
+ mutable item_comments : url option ;
+ mutable item_enclosure : enclosure option ;
+ mutable item_guid : guid option ;
+ mutable item_source : source option ;
}
type channel =
{
- ch_title : string ;
- ch_link : url ;
- ch_desc : string ;
- ch_language : string option ;
- ch_copyright : string option ;
- ch_managing_editor : email option ;
- ch_webmaster : email option ;
- ch_pubdate : Rss_date.t option ;
- ch_last_build_date : Rss_date.t option ;
- ch_categories : category list ;
- ch_generator : string option ;
-(* ch_cloud : cloud option ; *)
- ch_docs : url option ;
- ch_ttl : int option ;
- ch_image : image option ;
-(* ch_rating : pics_rating option ; *)
- ch_text_input : text_input option ;
+ mutable ch_title : string ;
+ mutable ch_link : url ;
+ mutable ch_desc : string ;
+ mutable ch_language : string option ;
+ mutable ch_copyright : string option ;
+ mutable ch_managing_editor : email option ;
+ mutable ch_webmaster : email option ;
+ mutable ch_pubdate : Rss_date.t option ;
+ mutable ch_last_build_date : Rss_date.t option ;
+ mutable ch_categories : category list ;
+ mutable ch_generator : string option ;
+(* mutable ch_cloud : cloud option ; *)
+ mutable ch_docs : url option ;
+ mutable ch_ttl : int option ;
+ mutable ch_image : image option ;
+(* mutable ch_rating : pics_rating option ; *)
+ mutable ch_text_input : text_input option ;
(*
- ch_skip_hours : skip_hours option ;
- ch_skip_days : skip_days option ;
+ mutable ch_skip_hours : skip_hours option ;
+ mutable ch_skip_days : skip_days option ;
*)
- ch_items : item list ;
+ mutable ch_items : item list ;
}
-
Index: mldonkey/src/utils/xml-light/xml.ml
diff -u mldonkey/src/utils/xml-light/xml.ml:1.1
mldonkey/src/utils/xml-light/xml.ml:1.2
--- mldonkey/src/utils/xml-light/xml.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/xml-light/xml.ml Thu Jan 26 10:40:01 2006
@@ -30,7 +30,7 @@
let default_parser = XmlParser.make()
let pos source =
- let line, lstart, min, max = pos source in
+ let line, lstart, min, max = Xml_lexer.pos source in
{
eline = line;
eline_start = lstart;
@@ -127,33 +127,7 @@
let tmp = Buffer.create 200
-let count_escapes text =
- let l = String.length text in
- let nescapes = ref 0 in
- let nbars = ref 0 in
- for p = 0 to l-1 do
- match text.[p] with
- | '>'
- | '<'
- | '&'
- | '\''
- | '"' ->
- nbars := 0;
- incr nescapes
- | ']' ->
- if !nbars = 1 then nescapes := -100000;
- incr nbars
- | _ -> nbars := 0
- done;
- !nescapes
-
let buffer_pcdata text =
- let n = count_escapes text in
- if n > 3 then begin
- Buffer.add_string tmp "<![CDATA[";
- Buffer.add_string tmp text;
- Buffer.add_string tmp "]]";
- end else
let l = String.length text in
for p = 0 to l-1 do
match text.[p] with
Index: mldonkey/src/utils/xml-light/xmlParser.ml
diff -u mldonkey/src/utils/xml-light/xmlParser.ml:1.1
mldonkey/src/utils/xml-light/xmlParser.ml:1.2
--- mldonkey/src/utils/xml-light/xmlParser.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/xml-light/xmlParser.ml Thu Jan 26 10:40:01 2006
@@ -108,7 +108,7 @@
let read_xml s =
match s.xparser.prove, pop s with
| true, Xml_lexer.DocType (root, DTDFile file) ->
- let pos = pos s.source in
+ let pos = Xml_lexer.pos s.source in
let dtd = s.xparser.resolve file in
Xml_lexer.restore pos;
let x = read_node s in
Index: mldonkey/src/utils/xml-light/xml_dtd.ml
diff -u mldonkey/src/utils/xml-light/xml_dtd.ml:1.1
mldonkey/src/utils/xml-light/xml_dtd.ml:1.2
--- mldonkey/src/utils/xml-light/xml_dtd.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/xml-light/xml_dtd.ml Thu Jan 26 10:40:01 2006
@@ -21,13 +21,6 @@
open Printf
-type dtd_result =
- | DTDNext
- | DTDNotMatched
- | DTDMatched
- | DTDMatchedResult of dtd_child
-
-
type parse_error_msg =
| InvalidDTDDecl
| InvalidDTDElement
@@ -41,6 +34,7 @@
| ElementEmptyContructor of string
| ElementReferenced of string * string
| ElementNotDeclared of string
+ | WrongImplicitValueForID of string * string
type prove_error =
| UnexpectedPCData
@@ -50,6 +44,14 @@
| RequiredAttribute of string
| ChildExpected of string
| EmptyExpected
+ | DuplicateID of string
+ | MissingID of string
+
+type dtd_result =
+ | DTDNext
+ | DTDNotMatched
+ | DTDMatched
+ | DTDMatchedResult of dtd_child
type parse_error = parse_error_msg * Xml_types.error_pos
@@ -73,7 +75,7 @@
let empty_hash = Hashtbl.create 0
let pos source =
- let line, lstart, min, max = pos source in
+ let line, lstart, min, max = Xml_lexer.pos source in
(Obj.magic {
eline = line;
eline_start = lstart;
@@ -140,6 +142,11 @@
Hashtbl.add hdone tag edata
in
let fattrib tag aname adata =
+ (match adata with
+ | DTDID,DTDImplied -> ()
+ | DTDID,DTDRequired -> ()
+ | DTDID,_ -> raise (Check_error (WrongImplicitValueForID
(tag,aname)))
+ | _ -> ());
let h = (try
Hashtbl.find attribs tag
with
@@ -210,16 +217,20 @@
Not_found -> raise (Check_error (ElementNotDeclared root))
+let to_string_ref = ref (fun _ -> assert false)
+
(* - for debug only -
let trace dtd tag =
let item = DTDElement ("current",dtd.current) in
printf "%s : %s\n"
(match tag with None -> "#PCDATA" | Some t -> t)
- (to_string item)
+ (!to_string_ref item)
*)
+exception TmpResult of dtd_result
+
let prove_child dtd tag =
match dtd.current with
| DTDEmpty -> raise (Prove_error EmptyExpected)
@@ -254,12 +265,16 @@
| DTDMatched
| DTDMatchedResult _ -> DTDMatchedResult (DTDZeroOrMore
x))
| DTDChoice l ->
+ (try
(match List.exists (fun x ->
match update x with
- | DTDMatched | DTDMatchedResult _ -> true
+ | DTDMatched -> true
+ | DTDMatchedResult _ as r -> raise (TmpResult r)
| DTDNext | DTDNotMatched -> false) l with
| true -> DTDMatched
| false -> DTDNotMatched)
+ with
+ TmpResult r -> r)
| DTDChildren [] -> assert false (* DTD is checked ! *)
| DTDChildren (h :: t) ->
(match update h with
@@ -289,7 +304,7 @@
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '.' | '-' | '_' | ':' -> true
| _ -> false
-let prove_attrib dtd attr aname (atype,adef) accu =
+let prove_attrib dtd hid hidref attr aname (atype,adef) accu =
let aval = (try Some (List.assoc aname attr) with Not_found -> None) in
(match atype, aval with
| DTDCData, _ -> ()
@@ -300,7 +315,14 @@
done
| DTDEnum l, None -> ()
| DTDEnum l, Some v ->
- if not (List.exists ((=) v) l) then raise (Prove_error
(InvalidAttributeValue aname)));
+ if not (List.exists ((=) v) l) then raise (Prove_error
(InvalidAttributeValue aname))
+ | DTDID, None -> ()
+ | DTDID, Some id ->
+ if Hashtbl.mem hid id then raise (Prove_error (DuplicateID id));
+ Hashtbl.add hid id ()
+ | DTDIDRef, None -> ()
+ | DTDIDRef, Some idref ->
+ Hashtbl.add hidref idref ());
match adef, aval with
| DTDRequired, None -> raise (Prove_error (RequiredAttribute aname))
| DTDFixed v, Some av when v <> av -> raise (Prove_error
(InvalidAttributeValue aname))
@@ -318,7 +340,7 @@
with
Not_found -> raise (Prove_error (UnexpectedAttribute aname))
-let rec do_prove dtd = function
+let rec do_prove hid hidref dtd = function
| PCData s ->
prove_child dtd None;
PCData s
@@ -332,8 +354,8 @@
dtd.curtag <- tag;
dtd.current <- elt;
List.iter (check_attrib ahash) uattr;
- let attr = Hashtbl.fold (prove_attrib dtd uattr) ahash [] in
- let childs = ref (List.map (do_prove dtd) childs) in
+ let attr = Hashtbl.fold (prove_attrib dtd hid hidref uattr)
ahash [] in
+ let childs = ref (List.map (do_prove hid hidref dtd) childs) in
(match dtd.current with
| DTDAny
| DTDEmpty -> ()
@@ -366,7 +388,13 @@
Element (tag,attr,!childs)
let prove dtd root xml =
- do_prove (start_prove dtd root) xml
+ let hid = Hashtbl.create 0 in
+ let hidref = Hashtbl.create 0 in
+ let x = do_prove hid hidref (start_prove dtd root) xml in
+ Hashtbl.iter (fun id () ->
+ if not (Hashtbl.mem hid id) then raise (Prove_error (MissingID
id))
+ ) hidref;
+ x
let parse_error_msg = function
| InvalidDTDDecl -> "Invalid DOCTYPE declaration"
@@ -388,6 +416,7 @@
| ElementEmptyContructor tag -> sprintf "Element '%s' has empty
constructor" tag
| ElementReferenced (tag,from) -> sprintf "Element '%s' referenced by
'%s' is not declared" tag from
| ElementNotDeclared tag -> sprintf "Element '%s' needed but is not
declared" tag
+ | WrongImplicitValueForID (tag,idname) -> sprintf "Attribute '%s' of
type ID of element '%s' not defined with implicit value #REQUIRED or #IMPLIED"
idname tag
let prove_error = function
| UnexpectedPCData -> "Unexpected PCData"
@@ -397,6 +426,8 @@
| RequiredAttribute att -> sprintf "Required attribute not found :
'%s'" att
| ChildExpected cname -> sprintf "Child expected : '%s'" cname
| EmptyExpected -> "No more children expected"
+ | DuplicateID id -> sprintf "ID '%s' used several times" id
+ | MissingID idref -> sprintf "missing ID value for IDREF '%s'" idref
let to_string = function
| DTDAttribute (tag,aname,atype,adef) ->
@@ -404,6 +435,8 @@
| DTDCData -> "CDATA"
| DTDNMToken -> "NMTOKEN"
| DTDEnum l -> sprintf "(%s)" (String.concat "|" l)
+ | DTDID -> "ID"
+ | DTDIDRef -> "IDREF"
in
let adefault_to_string = function
| DTDDefault s -> sprintf "\"%s\"" s
@@ -452,3 +485,5 @@
| r, false -> sprintf "(%s%s)"
(echild_to_string r) (op_to_string x)
in
sprintf "<!ELEMENT %s %s>" tag (etype_to_string etype)
+;;
+to_string_ref := to_string
Index: mldonkey/src/utils/xml-light/xml_dtd.mli
diff -u mldonkey/src/utils/xml-light/xml_dtd.mli:1.1
mldonkey/src/utils/xml-light/xml_dtd.mli:1.2
--- mldonkey/src/utils/xml-light/xml_dtd.mli:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/xml-light/xml_dtd.mli Thu Jan 26 10:40:01 2006
@@ -107,6 +107,7 @@
| ElementEmptyContructor of string
| ElementReferenced of string * string
| ElementNotDeclared of string
+ | WrongImplicitValueForID of string * string
type prove_error =
| UnexpectedPCData
@@ -116,6 +117,8 @@
| RequiredAttribute of string
| ChildExpected of string
| EmptyExpected
+ | DuplicateID of string
+ | MissingID of string
type parse_error = parse_error_msg * Xml_types.error_pos
Index: mldonkey/src/utils/xml-light/xml_lexer.mli
diff -u mldonkey/src/utils/xml-light/xml_lexer.mli:1.1
mldonkey/src/utils/xml-light/xml_lexer.mli:1.2
--- mldonkey/src/utils/xml-light/xml_lexer.mli:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/xml-light/xml_lexer.mli Thu Jan 26 10:40:01 2006
@@ -30,4 +30,5 @@
val close : Lexing.lexbuf -> unit
val token : Lexing.lexbuf -> token
val dtd : Lexing.lexbuf -> dtd
+val pos : Lexing.lexbuf -> pos
val restore : pos -> unit
\ No newline at end of file
Index: mldonkey/src/utils/xml-light/xml_lexer.mll
diff -u mldonkey/src/utils/xml-light/xml_lexer.mll:1.2
mldonkey/src/utils/xml-light/xml_lexer.mll:1.3
--- mldonkey/src/utils/xml-light/xml_lexer.mll:1.2 Sat Nov 19 17:19:45 2005
+++ mldonkey/src/utils/xml-light/xml_lexer.mll Thu Jan 26 10:40:01 2006
@@ -32,6 +32,10 @@
| DocType of (string * dtd_decl)
| Eof
+let last_pos = ref 0
+and current_line = ref 0
+and current_line_start = ref 0
+
let tmp = Buffer.create 200
let idents = Hashtbl.create 0
@@ -52,6 +56,11 @@
let close lexbuf =
Buffer.reset tmp
+let pos lexbuf =
+ !current_line , !current_line_start ,
+ !last_pos ,
+ lexeme_start lexbuf
+
let restore (cl,cls,lp,_) =
current_line := cl;
current_line_start := cls;
@@ -76,7 +85,8 @@
let space = [' ' '\t']
let identchar = ['A'-'Z' 'a'-'z' '_' '0'-'9' ':' '-']
let entitychar = ['A'-'Z' 'a'-'z']
-let pcchar = [^ '\r' '\n' '<' '&'] (* '>' *)
+let pcchar = [^ '\r' '\n' '<' '>' '&']
+let cdata_start = ['c''C']['d''D']['a''A']['t''T']['a''A']
rule token = parse
| newline
@@ -89,12 +99,6 @@
last_pos := lexeme_end lexbuf;
token lexbuf
}
- | "<![CDATA["
- {
- last_pos := lexeme_end lexbuf;
- Buffer.reset tmp;
- PCData (cdata lexbuf)
- }
| "<!DOCTYPE"
{
last_pos := lexeme_start lexbuf;
@@ -104,6 +108,12 @@
let data = dtd_data lexbuf in
DocType (root, data)
}
+ | "<![" cdata_start '['
+ {
+ last_pos := lexeme_start lexbuf;
+ Buffer.reset tmp;
+ PCData (cdata lexbuf)
+ }
| "<!--"
{
last_pos := lexeme_start lexbuf;
@@ -194,6 +204,28 @@
| _
{ header lexbuf }
+and cdata = parse
+ | [^ ']' '\n']+
+ {
+ Buffer.add_string tmp (lexeme lexbuf);
+ cdata lexbuf
+ }
+ | newline
+ {
+ newline lexbuf;
+ Buffer.add_string tmp (lexeme lexbuf);
+ cdata lexbuf
+ }
+ | "]]>"
+ { Buffer.contents tmp }
+ | ']'
+ {
+ Buffer.add_string tmp (lexeme lexbuf);
+ cdata lexbuf
+ }
+ | eof
+ { error lexbuf ECloseExpected }
+
and pcdata = parse
| pcchar+
{
@@ -213,15 +245,6 @@
| ""
{ Buffer.contents tmp }
-and cdata = parse
- | "]]"
- { Buffer.contents tmp }
- | _
- {
- Buffer.add_string tmp (lexeme lexbuf);
- cdata lexbuf
- }
-
and entity = parse
| entitychar+ ';'
{
@@ -402,7 +425,6 @@
| "<!"
{
ignore_spaces lexbuf;
- (* Printf.printf "?????"; print_newline (); *)
let t = dtd_item_type lexbuf in
let name = (try ident_name lexbuf with Error EIdentExpected -> raise
(DTDError EInvalidDTDDecl)) in
ignore_spaces lexbuf;
@@ -415,7 +437,10 @@
and dtd_attributes = parse
| '>'
- { [] }
+ {
+ ignore_spaces lexbuf;
+ []
+ }
| ""
{
let attrname = (try ident_name lexbuf with Error EIdentExpected -> raise
(DTDError EInvalidDTDAttribute)) in
@@ -519,6 +544,16 @@
ignore_spaces lexbuf;
DTDNMToken
}
+ | "ID"
+ {
+ ignore_spaces lexbuf;
+ DTDID
+ }
+ | "IDREF"
+ {
+ ignore_spaces lexbuf;
+ DTDIDRef
+ }
| '('
{
ignore_spaces lexbuf;
@@ -606,4 +641,3 @@
}
| _ | eof
{ dtd_error lexbuf EInvalidDTDAttribute }
-
Index: mldonkey/src/utils/xml-light/xml_types.ml
diff -u mldonkey/src/utils/xml-light/xml_types.ml:1.1
mldonkey/src/utils/xml-light/xml_types.ml:1.2
--- mldonkey/src/utils/xml-light/xml_types.ml:1.1 Thu Jul 29 10:25:34 2004
+++ mldonkey/src/utils/xml-light/xml_types.ml Thu Jan 26 10:40:01 2006
@@ -1,3 +1,5 @@
+(* moved from xml.ml *)
+
type xml =
| Element of (string * (string * string) list * xml list)
| PCData of string
@@ -21,11 +23,7 @@
| EndOfTagExpected of string
| EOFExpected
-
-
-
-
-(********** DTD **********)
+(* moved from dtd.ml, renamed to xml_dtd.ml *)
type dtd_child =
| DTDTag of string
@@ -51,6 +49,8 @@
| DTDCData
| DTDNMToken
| DTDEnum of string list
+ | DTDID
+ | DTDIDRef
type dtd_item =
| DTDAttribute of string * string * dtd_attr_type * dtd_attr_default
@@ -58,12 +58,14 @@
type dtd = dtd_item list
+type ('a,'b) hash = ('a,'b) Hashtbl.t
+
type checked = {
- c_elements : (string,dtd_element_type) Hashtbl.t;
- c_attribs : (string,(string,(dtd_attr_type * dtd_attr_default))
Hashtbl.t) Hashtbl.t;
+ c_elements : (string,dtd_element_type) hash;
+ c_attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash)
hash;
}
-(********** LEXER **********)
+(* moved from xml_lexer.mll *)
type error = error_msg * error_pos
@@ -93,15 +95,3 @@
| DTDData of dtd
type pos = int * int * int * int
-
-(******** WHY ???? it's a shame to use global vars for that ! *)
-let last_pos = ref 0
-and current_line = ref 0
-and current_line_start = ref 0
-
-let pos lexbuf =
- !current_line , !current_line_start ,
- !last_pos ,
- Lexing.lexeme_start lexbuf
-
-
\ No newline at end of file