wrappers/pl_HTTP_Cookies.ml

   1 (** Wrapper around Perl [HTTP::Cookies] class.
   2   *
   3   * Copyright (C) 2003 Merjis Ltd.
   4   *
   5   * $Id: pl_HTTP_Cookies.ml,v 1.1 2004-11-22 17:08:36 rich Exp $
   6   *)
   7
   8 open Perl
   9
  10 let _ = eval "use HTTP::Cookies"
  11
  12 class http_cookies sv =
  13
  14 object (self)
  15   method sv = sv
  16
  17   method save ?filename () =
  18     let args = match filename with
  19         None -> []
  20       | Some filename -> [sv_of_string filename] in
  21     call_method_void sv "save" args
  22
  23   method load ?filename () =
  24     let args = match filename with
  25         None -> []
  26       | Some filename -> [sv_of_string filename] in
  27     call_method_void sv "load" args
  28
  29   method revert () =
  30     call_method_void sv "revert" []
  31
  32   method as_string ?skip_discardables () =
  33     let args = match skip_discardables with
  34         None -> []
  35       | Some b -> [sv_of_bool b] in
  36     string_of_sv (call_method sv "as_string" args)
  37
  38 end
  39
  40 let new_ ?file ?autosave ?ignore_discard ?hide_cookie2 () =
  41   let args = ref [] in
  42   let may f = function None -> () | Some v -> f v in
  43   may (fun v ->
  44          args := sv_of_string "file" :: sv_of_string v :: !args) file;
  45   may (fun v ->
  46          args := sv_of_string "autosave" :: sv_of_bool v :: !args) autosave;
  47   may (fun v ->
  48          args := sv_of_string "ignore_discard" :: sv_of_bool v :: !args)
  49     ignore_discard;
  50   may (fun v ->
  51          args := sv_of_string "hide_cookie2" :: sv_of_bool v :: !args)
  52     hide_cookie2;
  53   let sv = call_class_method "HTTP::Cookies" "new" !args in
  54   new http_cookies sv