(*
* <COPYRIGHT>
* Copyright 2003 Gerd Stolpmann
*
* <GPL>
* This file is part of WTimer.
*
* WTimer is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* WTimer is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: db_types.ml,v 1.3 2003/03/23 11:59:13 gerd Exp $
* ----------------------------------------------------------------------
*
*)
module Types = struct
type date = { year : int; (* 4 digits *)
month : int; (* 1-12 *)
mday : int; (* 1-31 *)
}
type date_rec = date = { year : int; (* 4 digits *)
month : int; (* 1-12 *)
mday : int; (* 1-31 *)
}
type time = { hour : int; (* 0-23 *)
minute : int; (* 0-59 *)
}
type time_rec = time = { hour : int; (* 0-23 *)
minute : int; (* 0-59 *)
}
type interval = { delta_hours : int;
delta_minutes : int; (* 0-59 *)
}
type interval_rec = interval = { delta_hours : int;
delta_minutes : int; (* 0-59 *)
}
exception Bad_date
exception Bad_time
exception Bad_interval
end
let percent_N_bug =
(* Some versions of O'Caml return the wrong value for %N *)
Scanf.sscanf "X" "%N" (fun x -> x) = 1
module Date = struct
open Types
let days_of_month d =
let is_leapyear =
(d.year mod 400 = 0) || (d.year mod 4 = 0 && d.year mod 100 <> 0) in
match d.month with
( 1 | 3 | 5 | 7 | 8 | 10 | 12 ) -> 31
| ( 4 | 6 | 9 | 11 ) -> 30
| 2 -> if is_leapyear then 29 else 28
| _ -> assert false
let create d =
(* Check plausibility: *)
if d.year < 0 || d.month < 1 || d.month > 12 then raise Bad_date;
let days = days_of_month d in
if d.mday < 1 || d.mday > days then raise Bad_date;
d
let access d = d
let to_string d =
Printf.sprintf "%04d-%02d-%02d" d.year d.month d.mday
let from_string s =
try
let (yr, mn, md) =
Scanf.sscanf
(s ^ "X") (* Another bug: %N at the end of string does not work *)
"%4u-%2u-%2u%N"
(fun yr mn md n ->
let n' = if percent_N_bug then n-1 else n in
if n' = String.length s then
(yr,mn,md)
else
failwith "too many characters"
)
in
create { year = yr; month = mn; mday = md }
with
Scanf.Scan_failure msg ->
failwith ("Db.Date.from_string: Scan failure: " ^ msg)
| Failure msg ->
failwith ("Db.Date.from_string: " ^ msg)
| End_of_file ->
failwith ("Db.Date.from_string: too few characters")
let cmp d1 d2 =
if d1.year <> d2.year then
d1.year - d2.year
else
if d1.month <> d2.month then
d1.month - d2.month
else
d1.mday - d2.mday
end
module Time = struct
open Types
let create t =
(* Check plausibility: *)
if t.hour < 0 || t.hour > 23 || t.minute < 0 || t.minute > 59 then
raise Bad_time;
t
let access t = t
let to_string t =
Printf.sprintf "%02d:%02d" t.hour t.minute
let from_string s =
(* Note: seconds are ignored *)
try
let (hr, mi) =
Scanf.sscanf
(s ^ "X") (* Another bug: %N at the end of string does not work *)
"%2u:%2u%N"
(fun hr mi n ->
let n' = if percent_N_bug then n-1 else n in
if n' = String.length s then
(hr,mi)
else
if s.[n'] = ':' then
(hr,mi) (* ignore rest after ':' *)
else
failwith "too many characters"
)
in
create { hour = hr; minute = mi }
with
Scanf.Scan_failure msg ->
failwith ("Db.Time.from_string: Scan failure: " ^ msg)
| Failure msg ->
failwith ("Db.Time.from_string: " ^ msg)
| End_of_file ->
failwith ("Db.Time.from_string: too few characters")
let cmp t1 t2 =
if t1.hour <> t2.hour then
t1.hour - t2.hour
else
t1.minute - t2.minute
end
module Interval = struct
open Types
let create iv =
(* Check plausibility: *)
if abs iv.delta_minutes > 59 then raise Bad_interval;
if iv.delta_hours < 0 && iv.delta_minutes >= 0 then raise Bad_interval;
if iv.delta_hours >= 0 && iv.delta_minutes < 0 then raise Bad_interval;
iv
let access iv = iv
let to_string iv =
Printf.sprintf "%d:%02d" iv.delta_hours (abs iv.delta_minutes)
let from_string s =
(* Bug: intervals >= 1 day that use day notation cannot be processed:
* e.g. "5 days 15:45", or "12 years 65 days 3:00".
* Bug: "ago" for negative intervals is not recognized, e.g.
* "08:15 ago" instead of "-08:15".
*)
try
let (hr, mi) =
Scanf.sscanf
(s ^ "X") (* Another bug: %N at the end of string does not work *)
"%d:%2u%N"
(fun hr mi n ->
let n' = if percent_N_bug then n-1 else n in
if n' = String.length s then
(hr,mi)
else
if s.[n'] = ':' then
(hr,mi) (* ignore rest after ':' *)
else
failwith "too many characters"
)
in
let mi' = if hr < 0 then -mi else mi in
create { delta_hours = hr; delta_minutes = mi' }
with
Scanf.Scan_failure msg ->
failwith ("Db.Time.from_string: Scan failure: " ^ msg)
| Failure msg ->
failwith ("Db.Time.from_string: " ^ msg)
| End_of_file ->
failwith ("Db.Time.from_string: too few characters")
let cmp iv1 iv2 =
if iv1.delta_hours <> iv2.delta_hours then
iv1.delta_hours - iv2.delta_hours
else
iv1.delta_minutes - iv2.delta_minutes
let add iv1 iv2 =
let sum = iv1.delta_minutes + 60 * iv1.delta_hours +
iv2.delta_minutes + 60 * iv2.delta_hours in
{ delta_hours = sum / 60;
delta_minutes = sum mod 60;
}
let neg iv =
{ delta_hours = -iv.delta_hours;
delta_minutes = -iv.delta_minutes;
}
let move_by t iv =
let mi = t.minute + iv.delta_minutes in
let hr_carry =
if mi < 0 then (-1) else if mi > 59 then 1 else 0 in
{ hour = (t.hour + iv.delta_hours + hr_carry) mod 24;
minute = mi mod 60;
}
let delta t1 t2 =
if Time.cmp t1 t2 >= 0 then begin (* t1 >= t2 *)
let mi = t1.minute - t2.minute in
let mi' = if mi >= 0 then mi else 60 + mi in
let hr_carry = if mi >= 0 then 0 else -1 in
{ delta_hours = t1.hour - t2.hour + hr_carry;
delta_minutes = mi';
}
end
else begin
let mi = t2.minute - t1.minute in
let mi' = if mi >= 0 then mi else 60 + mi in
let hr_carry = if mi >= 0 then 0 else -1 in
{ delta_hours = -(t2.hour - t1.hour + hr_carry);
delta_minutes = -mi';
}
end
let distance t1 t2 =
let d = delta t1 t2 in
let m_mod = d.delta_minutes mod 60 in
let h_carry = if m_mod < 0 then -1 else 0 in
let h_mod = (d.delta_hours + h_carry) mod 24 in
{ delta_hours = if h_mod < 0 then 24 + h_mod else h_mod;
delta_minutes = if m_mod < 0 then 60 + m_mod else m_mod;
}
end
(* ======================================================================
* History:
*
* $Log: db_types.ml,v $
* Revision 1.3 2003/03/23 11:59:13 gerd
* GPL
*
* Revision 1.2 2003/01/16 00:39:25 gerd
* Continued.
*
* Revision 1.1 2002/11/16 12:34:51 gerd
* Initial revision
*
*
*)
