Fixed for Perl 5.8.2.

[perl4caml.git] / wrappers / pl_Date_Parse.ml

diff --git a/wrappers/pl_Date_Parse.ml b/wrappers/pl_Date_Parse.ml
new file mode 100644 (file)
index 0000000..42b4ece
--- /dev/null
+++ b/wrappers/pl_Date_Parse.ml
@@ -0,0 +1,45 @@
+(** Wrapper around Perl [Date::Parse] class.
+  *
+  * Copyright (C) 2003 Merjis Ltd.
+  *
+  * $Id: pl_Date_Parse.ml,v 1.1 2003-11-19 16:28:23 rich Exp $
+  *)
+
+open Perl
+
+let _ = eval "use Date::Parse qw()"
+
+(* XXX languages not supported yet - when it is supported, it'll be in
+ * [pl_Date_Language] anyway, not here  -- RWMJ
+ *)
+
+let str2time ?zone date =
+  let args =
+    [sv_of_string date] @
+    match zone with
+       None -> []
+      | Some zone -> [sv_of_string zone] in
+  let sv = call ~fn:"Date::Parse::str2time" args in
+  if sv_is_undef sv then
+    invalid_arg "Date::Parse: Could not parse date";
+  float_of_sv sv
+
+let strptime ?zone date =
+  let args =
+    [sv_of_string date] @
+    match zone with
+       None -> []
+      | Some zone -> [sv_of_string zone] in
+  let svs = call_array ~fn:"Date::Parse::strptime" args in
+  match svs with
+      [] -> invalid_arg "Date::Parse: Could not parse date"
+    | [ ss; mm; hh; day; month; year; zone ] ->
+       ((if sv_is_undef ss then None else Some (int_of_sv ss)),
+        (if sv_is_undef mm then None else Some (int_of_sv mm)),
+        (if sv_is_undef hh then None else Some (int_of_sv hh)),
+        (if sv_is_undef day then None else Some (int_of_sv day)),
+        (if sv_is_undef month then None else Some (int_of_sv month)),
+        (if sv_is_undef year then None else Some (int_of_sv year)),
+        (if sv_is_undef zone then None else Some (string_of_sv zone)))
+    | _ ->
+       failwith "Pl_Date_Parse: invalid list returned by strptime"