wrappers/pl_Date_Parse.ml

   1 (** Wrapper around Perl [Date::Parse] class.
   2   *
   3   * Copyright (C) 2003 Merjis Ltd.
   4   *
   5   * $Id: pl_Date_Parse.ml,v 1.1 2003-11-19 16:28:23 rich Exp $
   6   *)
   7
   8 open Perl
   9
  10 let _ = eval "use Date::Parse qw()"
  11
  12 (* XXX languages not supported yet - when it is supported, it'll be in
  13  * [pl_Date_Language] anyway, not here  -- RWMJ
  14  *)
  15
  16 let str2time ?zone date =
  17   let args =
  18     [sv_of_string date] @
  19     match zone with
  20         None -> []
  21       | Some zone -> [sv_of_string zone] in
  22   let sv = call ~fn:"Date::Parse::str2time" args in
  23   if sv_is_undef sv then
  24     invalid_arg "Date::Parse: Could not parse date";
  25   float_of_sv sv
  26
  27 let strptime ?zone date =
  28   let args =
  29     [sv_of_string date] @
  30     match zone with
  31         None -> []
  32       | Some zone -> [sv_of_string zone] in
  33   let svs = call_array ~fn:"Date::Parse::strptime" args in
  34   match svs with
  35       [] -> invalid_arg "Date::Parse: Could not parse date"
  36     | [ ss; mm; hh; day; month; year; zone ] ->
  37         ((if sv_is_undef ss then None else Some (int_of_sv ss)),
  38          (if sv_is_undef mm then None else Some (int_of_sv mm)),
  39          (if sv_is_undef hh then None else Some (int_of_sv hh)),
  40          (if sv_is_undef day then None else Some (int_of_sv day)),
  41          (if sv_is_undef month then None else Some (int_of_sv month)),
  42          (if sv_is_undef year then None else Some (int_of_sv year)),
  43          (if sv_is_undef zone then None else Some (string_of_sv zone)))
  44     | _ ->
  45         failwith "Pl_Date_Parse: invalid list returned by strptime"