From: rich Date: Wed, 19 Nov 2003 16:28:22 +0000 (+0000) Subject: Fixed for Perl 5.8.2. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=60e320772abf3bdd6402ed4fb5513bbe50540d1b;p=perl4caml.git Fixed for Perl 5.8.2. Added date parsing wrappers which we can use in the assessortool. --- diff --git a/.depend b/.depend index 544ba14..fd4e05e 100644 --- a/.depend +++ b/.depend @@ -8,8 +8,18 @@ examples/loadpage.cmo: perl.cmi wrappers/pl_HTML_Element.cmo \ 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 diff --git a/Makefile b/Makefile index fb966ad..517d4eb 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ # 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 @@ -17,7 +17,7 @@ OCAMLCFLAGS := -w s -g $(OCAMLCINCS) 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) @@ -26,11 +26,14 @@ SED := sed # 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 \ @@ -54,7 +57,8 @@ perl4caml.cmxa: perl.cmx perl_c.o $(WRAPPERS:.cmo=.cmx) $(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 $@ @@ -77,6 +81,13 @@ examples/google.opt: examples/google.cmx $(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 $< @@ -95,10 +106,11 @@ META: META.in Makefile.config # 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. diff --git a/Makefile.config b/Makefile.config index 043ba7a..637ca6c 100644 --- a/Makefile.config +++ b/Makefile.config @@ -1,5 +1,5 @@ # 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. . @@ -12,7 +12,12 @@ PERLINCDIR := $(shell perl -MConfig -e 'print "$$Config{archlib}/CORE"') 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 diff --git a/examples/.cvsignore b/examples/.cvsignore index 0560bb3..725d37b 100644 --- a/examples/.cvsignore +++ b/examples/.cvsignore @@ -6,6 +6,8 @@ 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 diff --git a/examples/parsedate.ml b/examples/parsedate.ml new file mode 100644 index 0000000..7a05cfd --- /dev/null +++ b/examples/parsedate.ml @@ -0,0 +1,31 @@ +(* 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 () diff --git a/perl_c.c b/perl_c.c index 7f3bddd..dc5b93b 100644 --- a/perl_c.c +++ b/perl_c.c @@ -1,6 +1,6 @@ /* 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 @@ -20,6 +20,10 @@ */ #define off64_t __off64_t +/* XXX This is required by Perl >= 5.8.2. */ +#define __USE_GNU +#include + #include #include diff --git a/wrappers/pl_Date_Calc.ml b/wrappers/pl_Date_Calc.ml new file mode 100644 index 0000000..a229562 --- /dev/null +++ b/wrappers/pl_Date_Calc.ml @@ -0,0 +1,68 @@ +(** 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 *) diff --git a/wrappers/pl_Date_Format.ml b/wrappers/pl_Date_Format.ml new file mode 100644 index 0000000..f36d689 --- /dev/null +++ b/wrappers/pl_Date_Format.ml @@ -0,0 +1,51 @@ +(** 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) diff --git a/wrappers/pl_Date_Parse.ml b/wrappers/pl_Date_Parse.ml new file mode 100644 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"