(** 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 *)