Added date parsing wrappers which we can use in the assessortool.
examples/loadpage.cmx: perl.cmx wrappers/pl_HTML_Element.cmx \
wrappers/pl_HTML_TreeBuilder.cmx wrappers/pl_HTTP_Request.cmx \
wrappers/pl_LWP_UserAgent.cmx
+examples/parsedate.cmo: perl.cmi wrappers/pl_Date_Format.cmo \
+ wrappers/pl_Date_Parse.cmo
+examples/parsedate.cmx: perl.cmx wrappers/pl_Date_Format.cmx \
+ wrappers/pl_Date_Parse.cmx
examples/test.cmo: perl.cmi
examples/test.cmx: perl.cmx
+wrappers/pl_Date_Calc.cmo: perl.cmi
+wrappers/pl_Date_Calc.cmx: perl.cmx
+wrappers/pl_Date_Format.cmo: perl.cmi
+wrappers/pl_Date_Format.cmx: perl.cmx
+wrappers/pl_Date_Parse.cmo: perl.cmi
+wrappers/pl_Date_Parse.cmx: perl.cmx
wrappers/pl_HTML_Element.cmo: perl.cmi
wrappers/pl_HTML_Element.cmx: perl.cmx
wrappers/pl_HTML_Parser.cmo: perl.cmi
# Interface to Perl from OCaml.
# Copyright (C) 2003 Merjis Ltd.
-# $Id: Makefile,v 1.18 2003-11-08 11:52:03 rich Exp $
+# $Id: Makefile,v 1.19 2003-11-19 16:28:22 rich Exp $
include Makefile.config
OCAMLOPTFLAGS := -w s $(OCAMLOPTINCS)
CC := gcc
-CFLAGS := -Wall -Wno-unused -I$(PERLINCDIR)
+CFLAGS := -Wall -Wno-unused -I$(PERLINCDIR) $(EXTRA_CFLAGS)
LIBPERL := $(shell perl -MExtUtils::Embed -e ldopts)
# XXX Hack required by ocamlopt, and sometimes ocamlc.
# To work out what this should be, try:
# `perl -MExtUtils::Embed -e ldopts'
-DYNALOADER_HACK := /usr/lib/perl/5.8.1/auto/DynaLoader/DynaLoader.a
+DYNALOADER_HACK := /usr/lib/perl/5.8.2/auto/DynaLoader/DynaLoader.a
OCAMLDOCFLAGS := -html -stars -sort $(OCAMLCINCS)
WRAPPERS := \
+ wrappers/pl_Date_Calc.cmo \
+ wrappers/pl_Date_Format.cmo \
+ wrappers/pl_Date_Parse.cmo \
wrappers/pl_Net_Google_Cache.cmo \
wrappers/pl_Net_Google_Response.cmo \
wrappers/pl_Net_Google_Search.cmo \
$(OCAMLMKLIB) -o perl4caml $(LIBPERL) $^
all-examples: examples/test examples/loadpage examples/google \
- examples/test.opt examples/loadpage.opt examples/google.opt
+ examples/test.opt examples/loadpage.opt examples/google.opt \
+ examples/parsedate examples/parsedate.opt
examples/test: examples/test.cmo
$(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@
$(OCAMLOPT) $(OCAMLOPTFLAGS) -cclib -L. perl4caml.cmxa \
$(DYNALOADER_HACK) $^ -o $@
+examples/parsedate: examples/parsedate.cmo
+ $(OCAMLC) $(OCAMLCFLAGS) perl4caml.cma $^ -o $@
+
+examples/parsedate.opt: examples/parsedate.cmx
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) -cclib -L. perl4caml.cmxa \
+ $(DYNALOADER_HACK) $^ -o $@
+
%.cmi: %.mli
$(OCAMLC) $(OCAMLCFLAGS) -c $<
# Clean.
-JUNKFILES = core *~ *.bak *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so
+JUNKFILES = core *~ *.bak *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so *.opt
clean:
- rm -f META examples/test examples/loadpage examples/google
+ rm -f META examples/test examples/loadpage examples/google \
+ examples/parsedate
for d in . examples wrappers; do (cd $$d; rm -f $(JUNKFILES)); done
# Build dependencies.
# perl4caml configuration -*- Makefile -*-
-# $Id: Makefile.config,v 1.11 2003-10-26 10:20:19 rich Exp $
+# $Id: Makefile.config,v 1.12 2003-11-19 16:28:22 rich Exp $
# PERLINCDIR
# Directory containing the Perl include files, eg. <EXTERN.h>.
OCAMLLIBDIR := $(shell ocamlc -where)
+# EXTRA_CFLAGS
+# You can specify extra flags to be passed to gcc here.
+
+EXTRA_CFLAGS :=
+
# PACKAGE and VERSION
PACKAGE := perl4caml
-VERSION := 0.3.6
+VERSION := 0.3.7
test
loadpage
google
+parsedate
test.opt
loadpage.opt
-google.opt
\ No newline at end of file
+google.opt
+parsedate.opt
\ No newline at end of file
--- /dev/null
+(* Example program which uses Date::Parse.
+ * Copyright (C) 2003 Merjis Ltd.
+ * $Id: parsedate.ml,v 1.1 2003-11-19 16:28:22 rich Exp $
+ *)
+
+open Printf
+
+open Pl_Date_Parse
+open Pl_Date_Format
+
+let () =
+ (* Parse dates passed on the command line. *)
+ if Array.length Sys.argv <= 1 then
+ eprintf "parsedate [list of quoted date strings ...]\n"
+ else (
+ let strings = List.tl (Array.to_list Sys.argv) in
+ List.iter (fun s ->
+ printf "input string = '%s' ->\n" s;
+ let t = str2time s in
+ printf "\ttime_t = %f\n" t;
+ let s = ctime t in
+ printf "\tconverted back to string = %s\n" s;
+ printf "\n"
+ ) strings
+ );
+
+ (* Destroy the Perl interpreter. *)
+ Perl.destroy (Perl.current_interpreter ());
+
+ (* Perform a full collection - good way to find GC/allocation bugs. *)
+ Gc.full_major ()
/* Interface to Perl from OCaml.
* Copyright (C) 2003 Merjis Ltd.
- * $Id: perl_c.c,v 1.11 2003-10-26 12:57:11 rich Exp $
+ * $Id: perl_c.c,v 1.12 2003-11-19 16:28:22 rich Exp $
*/
#include <stdio.h>
*/
#define off64_t __off64_t
+/* XXX This is required by Perl >= 5.8.2. */
+#define __USE_GNU
+#include <crypt.h>
+
#include <EXTERN.h>
#include <perl.h>
--- /dev/null
+(** Wrapper around Perl [Date::Calc] class.
+ *
+ * Copyright (C) 2003 Merjis Ltd.
+ *
+ * $Id: pl_Date_Calc.ml,v 1.1 2003-11-19 16:28:23 rich Exp $
+ *)
+
+open Perl
+
+let _ = eval "use Date::Calc qw()"
+
+let days_in_year year month =
+ int_of_sv (call ~fn:"Date::Calc::Days_in_Year"
+ [sv_of_int year; sv_of_int month])
+
+let days_in_month year month =
+ int_of_sv (call ~fn:"Date::Calc::Days_in_Month"
+ [sv_of_int year; sv_of_int month])
+
+let weeks_in_year year =
+ int_of_sv (call ~fn:"Date::Calc::Weeks_in_Year" [sv_of_int year])
+
+let leap_year year =
+ bool_of_sv (call ~fn:"Date::Calc::leap_year" [sv_of_int year])
+
+let check_date year month day =
+ bool_of_sv (call ~fn:"Date::Calc::check_date"
+ [sv_of_int year; sv_of_int month; sv_of_int day])
+
+let check_time hour min sec =
+ bool_of_sv (call ~fn:"Date::Calc::check_time"
+ [sv_of_int hour; sv_of_int min; sv_of_int sec])
+
+let check_business_date year week dow =
+ bool_of_sv (call ~fn:"Date::Calc::check_business_date"
+ [sv_of_int year; sv_of_int week; sv_of_int dow])
+
+let day_of_year year month day =
+ int_of_sv (call ~fn:"Date::Calc::Day_of_Year"
+ [sv_of_int year; sv_of_int month; sv_of_int day])
+
+let date_to_days year month day =
+ int_of_sv (call ~fn:"Date::Calc::Date_to_Days"
+ [sv_of_int year; sv_of_int month; sv_of_int day])
+
+let day_of_week year month day =
+ int_of_sv (call ~fn:"Date::Calc::Day_of_Week"
+ [sv_of_int year; sv_of_int month; sv_of_int day])
+
+let week_number year month day =
+ int_of_sv (call ~fn:"Date::Calc::Week_Number"
+ [sv_of_int year; sv_of_int month; sv_of_int day])
+
+let week_of_year year month day =
+ let r = call_array ~fn:"Date::Calc::Week_of_Year"
+ [sv_of_int year; sv_of_int month; sv_of_int day] in
+ match r with
+ [week; year] -> int_of_sv week, int_of_sv year
+ | _ -> failwith "Pl_Date_Calc: week_of_year: unexpected return value"
+
+let monday_of_week week year =
+ let r = call_array ~fn:"Date::Calc::Monday_of_Week"
+ [sv_of_int week; sv_of_int year] in
+ match r with
+ [year; month; day] -> int_of_sv year, int_of_sv month, int_of_sv day
+ | _ -> failwith "Pl_Date_Calc: monday_of_week: unexpected return value"
+
+(* at this point I got bored ... - RWMJ *)
--- /dev/null
+(** Wrapper around Perl [Date::Format] class.
+ *
+ * Copyright (C) 2003 Merjis Ltd.
+ *
+ * $Id: pl_Date_Format.ml,v 1.1 2003-11-19 16:28:23 rich Exp $
+ *)
+
+open Perl
+
+let _ = eval "use Date::Format qw()"
+
+let language lang =
+ call_class_method_void "Date::Format" "language" [sv_of_string lang]
+
+(* This is just provided for your convenience so you can pass the resulting
+ * list of SVs directly to the second argument of {!Pl_Date_Format.strftime}.
+ *)
+let localtime () =
+ call_array ~fn:"localtime" []
+
+let time2str ?zone templ time =
+ let args =
+ [sv_of_string templ; sv_of_float time] @
+ match zone with
+ None -> []
+ | Some zone -> [sv_of_string zone] in
+ string_of_sv (call ~fn:"Date::Format::time2str" args)
+
+let strftime ?zone templ time =
+ let args =
+ (sv_of_string templ :: time) @
+ match zone with
+ None -> []
+ | Some zone -> [sv_of_string zone] in
+ string_of_sv (call ~fn:"Date::Format::strftime" args)
+
+let ctime ?zone time =
+ let args =
+ [sv_of_float time] @
+ match zone with
+ None -> []
+ | Some zone -> [sv_of_string zone] in
+ string_of_sv (call ~fn:"Date::Format::ctime" args)
+
+let asctime ?zone time =
+ let args =
+ [sv_of_float time] @
+ match zone with
+ None -> []
+ | Some zone -> [sv_of_string zone] in
+ string_of_sv (call ~fn:"Date::Format::asctime" args)
--- /dev/null
+(** 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"
git.annexia.org / perl4caml.git / commitdiff