wrappers/pl_HTTP_Request.ml

   1 (** Wrapper around Perl [HTTP::Request] class.
   2   *
   3   * Copyright (C) 2003 Merjis Ltd.
   4   *
   5   * $Id: pl_HTTP_Request.ml,v 1.4 2005-01-13 16:06:04 rich Exp $
   6   *)
   7
   8 open Perl
   9
  10 open Pl_HTTP_Message
  11 open Pl_URI
  12
  13 let _ = eval "use HTTP::Request"
  14
  15 class http_request sv =
  16
  17 object (self)
  18   inherit http_message sv
  19
  20   method sv = sv
  21
  22   method method_ =
  23     string_of_sv (call_method sv "method" [])
  24   method set_method meth =
  25     call_method_void sv "method" [sv_of_string meth]
  26   method uri =
  27     string_of_sv (call_method sv "uri" [])
  28   method set_uri uri =
  29     call_method_void sv "uri" [sv_of_string uri]
  30   method as_string =
  31     string_of_sv (call_method sv "as_string" [])
  32
  33 end
  34
  35 let new_ meth ?uri_obj ?uri (* ?header ?content *) () =
  36   let sv =
  37     match uri_obj, uri with
  38         None, None ->
  39           failwith ("Pl_HTTP_Request.new_ must be called with either a "^
  40                     "~uri_obj (URI object) or ~uri (string) parameter.")
  41       | Some (uri_obj : uri), None ->
  42           call_class_method "HTTP::Request" "new" [sv_of_string meth;
  43                                                    uri_obj#sv]
  44       | _, Some uri ->
  45           call_class_method "HTTP::Request" "new" [sv_of_string meth;
  46                                                    sv_of_string uri]
  47   in
  48   new http_request sv