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.1 2003-10-12 17:33:15 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          match sv_type c with
  47              SVt_PV -> String (string_of_sv c)
  48            | SVt_RV -> Element (new html_element (deref c))
  49            | _ -> failwith "HTML::Element content_type: unknown type"
  50       ) svlist
  51   method all_attr =
  52     let svlist = call_method_array sv "all_attr" [] in
  53     assocs_of_svlist svlist
  54   method all_attr_names =
  55     let svlist = call_method_array sv "all_attr_names" [] in
  56     list_of_svlist svlist
  57   method all_external_attr =
  58     let svlist = call_method_array sv "all_external_attr" [] in
  59     assocs_of_svlist svlist
  60   method all_external_attr_names =
  61     let svlist = call_method_array sv "all_external_attr_names" [] in
  62     list_of_svlist svlist
  63
  64 end
  65
  66 (* Note that "new" is a reserved word, so I've appended an _ character. *)
  67 let new_ tag attrs =
  68   let rec loop = function
  69       [] -> []
  70     | (name, value) :: xs -> sv_of_string name :: sv_of_string value :: loop xs
  71   in
  72   let sv = call_class_method "HTML::Element" "new"
  73              (sv_of_string tag :: loop attrs) in
  74   new html_element sv