wrappers/pl_HTML_Element.ml

   1 (* Wrapper around Perl HTML::Element class.
   2  * Copyright (C) 2003 Merjis Ltd.
   3  * $Id: pl_HTML_Element.ml,v 1.2 2003-10-14 16:05:22 rich Exp $
   4  *)
   5
   6 open Perl
   7
   8 type 'a content_t = Element of 'a | String of string
   9
  10 class html_element sv =
  11
  12   let rec assocs_of_svlist = function
  13       [] -> []
  14     | [x] -> failwith "HTML::Element all_attr returned odd-length list!"
  15     | svname :: svvalue :: xs ->
  16         (string_of_sv svname, string_of_sv svvalue) :: assocs_of_svlist xs
  17   in
  18
  19   let rec list_of_svlist = function
  20       [] -> []
  21     | sv :: xs ->
  22         string_of_sv sv :: list_of_svlist xs
  23   in
  24
  25 object (self)
  26
  27   method sv = sv
  28
  29   method attr name =
  30     string_of_sv (call_method sv "attr" [sv_of_string name])
  31   method set_attr name value =
  32     call_method_void sv "attr" [sv_of_string name; sv_of_string value]
  33   method tag =
  34     string_of_sv (call_method sv "tag" [])
  35   method set_tag tag =
  36     call_method_void sv "tag" [sv_of_string tag]
  37   method parent =
  38     let sv = call_method sv "parent" [] in
  39     new html_element sv
  40   method set_parent (parent : html_element) =
  41     call_method_void sv "parent" [parent#sv]
  42   method content_list =
  43     let svlist = call_method_array sv "content_list" [] in
  44     List.map
  45       (fun c ->
  46          (* Not very satisfactory, but sv_type fails to discern the type
  47           * for some reason. XXX
  48           *)
  49          let str = string_of_sv c in
  50          let marker = "HTML::Element=HASH(" in
  51          let marker_len = String.length marker in
  52          if String.length str > marker_len &&
  53            String.sub str 0 marker_len = marker then
  54              Element (new html_element c)
  55          else
  56            String (string_of_sv c)
  57       ) svlist
  58   method all_attr =
  59     let svlist = call_method_array sv "all_attr" [] in
  60     assocs_of_svlist svlist
  61   method all_attr_names =
  62     let svlist = call_method_array sv "all_attr_names" [] in
  63     list_of_svlist svlist
  64   method all_external_attr =
  65     let svlist = call_method_array sv "all_external_attr" [] in
  66     assocs_of_svlist svlist
  67   method all_external_attr_names =
  68     let svlist = call_method_array sv "all_external_attr_names" [] in
  69     list_of_svlist svlist
  70
  71 end
  72
  73 (* Note that "new" is a reserved word, so I've appended an _ character. *)
  74 let new_ tag attrs =
  75   let rec loop = function
  76       [] -> []
  77     | (name, value) :: xs -> sv_of_string name :: sv_of_string value :: loop xs
  78   in
  79   let sv = call_class_method "HTML::Element" "new"
  80              (sv_of_string tag :: loop attrs) in
  81   new html_element sv