Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 101 lines (90 sloc) 3.721 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (* depends *)
19 module List = BaseList
20
21 (* -- *)
22
23 (* http://en.wikipedia.org/wiki/Computus *)
24 let easter y =
25 let a = y mod 19 in
26 let b = y / 100 in
27 let c = y mod 100 in
28 let d = b / 4 in
29 let e = b mod 4 in
30 let f = (b + 8) / 25 in
31 let g = (b - f + 1) / 3 in
32 let h = (19 * a + b - d - g + 15) mod 30 in
33 let i = c / 4 in
34 let k = c mod 4 in
35 let l = (32 + 2 * e + 2 * i - h - k) mod 7 in
36 let m = (a + 11 * h + 22 * l) / 451 in
37 let month = (h + l - 7 * m + 114) / 31 in
38 let day = ((h + l - 7 * m + 114) mod 31) + 1 in
39 month, day
40
41 open Unix
42 (* type date = Rfc1123 | Rfc850 | Asctime *)
43 let month = [|"Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun"; "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec"|]
44 let month_li = Array.to_list month
45
46 let fullmonth = [|"January"; "February"; "March"; "April"; "May"; "June"
47 ; "July"; "August"; "September"; "October"; "November"; "December"|]
48 let date1 dt = Printf.sprintf "%02d %s %04d" dt.tm_mday month.(dt.tm_mon) (1900+dt.tm_year)
49 let date2 dt = Printf.sprintf "%02d-%s-%02d" dt.tm_mday month.(dt.tm_mon)
50 (if dt.tm_year<100 then dt.tm_year else dt.tm_year-100)
51 let date3 dt = Printf.sprintf "%s %02d" month.(dt.tm_mon) dt.tm_mday
52 let time dt = Printf.sprintf "%02d:%02d:%02d" dt.tm_hour dt.tm_min dt.tm_sec
53 let wkday = [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|]
54 let weekday = [|"Sunday"; "Monday"; "Tuesday"; "Wednesday"; "Thursday"; "Friday"; "Saturday"|]
55 (* let asctime dt = Printf.sprintf "%s %s %s %s" wkday.(dt.tm_wday) (date3 dt) (time dt) (year dt) *)
56 let rfc850 dt = Printf.sprintf "%s, %s %s GMT" weekday.(dt.tm_wday) (date2 dt) (time dt)
57 let rfc1123 dt = Printf.sprintf "%s, %s %s GMT" wkday.(dt.tm_wday) (date1 dt) (time dt)
58 let gmt_dec =
59 let time = Time.now () in
60 (Time.localtime time).tm_hour - (Time.gmtime time).tm_hour
61 let of_string (* rfc 1123 *) s =
62 Scanf.sscanf s "%s %02d %s %04d %02d:%02d:%02d GMT"
63 (fun _ day month year h min sec ->
64 let month_cnv =
65 match List.findi (fun i -> i = month) month_li with
66 | Some s -> s
67 | None -> failwith "Date.of_string"
68 in
69 Time.mktime ~year ~month:month_cnv ~day ~h:(h + gmt_dec) ~min ~sec ~ms:0
70 )
71
72 let date f dt = match f with
73 | `rfc1123 -> rfc1123 dt
74 | `rfc850 -> rfc850 dt
75 | `asctime -> "" (*asctime dt FIXME *)
76
77 let pretty_duration dur =
78 if dur < 2. then
79 Printf.sprintf "00:00:0%0.3f" dur
80 else if dur < 10. then
81 Printf.sprintf "00:00:0%.2f" dur
82 else if dur < 60. then
83 Printf.sprintf "00:00:%.1f" dur
84 else
85 let dur_sec = int_of_float dur in
86 let sec = dur_sec mod 60 in
87 let dur_min = dur_sec / 60 in
88 let min = dur_min mod 60 in
89 let dur_hour = dur_min / 60 in
90 let hour = dur_hour mod 24 in
91 if dur_hour < 24 then
92 Printf.sprintf "%02d:%02d:%02d" hour min sec
93 else
94 let dur_day = dur_hour / 24 in
95 if dur_day < 2 then
96 Printf.sprintf "%d day %d h %d min" dur_day hour min
97 else if dur_day < 31 then
98 Printf.sprintf "%d days %d h" dur_day hour
99 else
100 Printf.sprintf "%d days" dur_day
Something went wrong with that request. Please try again.