File: pdfdate.ml

package info (click to toggle)
camlpdf 0.5-1
  • links: PTS, VCS
  • area: non-free
  • in suites: squeeze, wheezy
  • size: 1,516 kB
  • ctags: 2,689
  • sloc: ml: 18,229; ansic: 139; makefile: 139
file content (114 lines) | stat: -rw-r--r-- 3,571 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
open Utility

type t =
  {year : int;
   month : int;
   day : int;
   hour : int;
   minute : int;
   second : int;
   hour_offset : int;
   minute_offset : int}

exception BadDate

let check_date d = 
  try
    assert (d.year >= 0 && d.year <= 9999);
    assert (d.month >= 1 && d.month <= 12);
    assert (d.day >= 1 && d.day <= 31);
    assert (d.hour >= 0 && d.hour <= 23);
    assert (d.minute >= 0 && d.minute <= 59);
    assert (d.second >= 0 && d.second <= 59);
    assert (d.hour_offset >= ~-23 && d.hour_offset <= 23);
    assert (d.minute_offset >= ~-59 && d.minute_offset <= 59);
  with
    _ -> raise BadDate

(* For now, no detection of default values which could be omitted. *)
let string_of_date d =
  check_date d;
  let ostr =
    if d.hour_offset < 0 then
      Printf.sprintf "-%02i'%02i'" (abs d.hour_offset) (abs d.minute_offset)
    else if d.hour_offset > 0 then
      Printf.sprintf "+%02i'%02i'" (abs d.hour_offset) (abs d.minute_offset)
    else "Z"
  in
    Printf.sprintf
      "D:%04i%02i%02i%02i%02i%02i%s"
      d.year d.month d.day d.hour d.minute d.second ostr

let date_of_string s =
  let safe_int_string chars =
    try int_of_string (implode chars) with
      _ -> raise BadDate
  in
    let hour_offset = ref 0
    and minute_offset = ref 0
    and o = ref 0 in
      let rec optional_twochar def cs =
        match cs with
        | ('-' | '+' | 'Z')::_ ->
            parse_local_time cs;
            def, []
        | a::b::more -> safe_int_string [a;b], more
        | _ -> def, []
      and parse_local_time cs =
        let o_got, cs =
          match cs with
          | '+'::more -> 1, more
          | '-'::more -> ~-1, more
          | 'Z'::more -> 0, more
          | _ -> 0, []
        in
          let h, cs = optional_twochar 0 cs in
            match cs with
            | [] -> ()
            | _ ->
                let m, cs = optional_twochar 0 (tl cs) in
                  hour_offset := h;
                  minute_offset := m;
                  o := o_got
      in
        let cs = explode s in
          let cs =
            match cs with
            | 'D'::':'::more -> more
            | _ -> cs
          in
            let year, cs =
              match cs with
              | a::b::c::d::more -> safe_int_string [a;b;c;d], more
              | _ -> raise BadDate
            in
              let month, cs = optional_twochar 1 cs in
                let day, cs = optional_twochar 1 cs in
                  let hour, cs = optional_twochar 0 cs in
                    let minute, cs = optional_twochar 0 cs in
                      let second, cs = optional_twochar 0 cs in
                        parse_local_time cs;
                        let date =
                          {year = year;
                           month = month;
                           day = day;
                           hour = hour;
                           minute = minute;
                           second = second;
                           hour_offset = !hour_offset * !o;
                           minute_offset = !minute_offset * !o}
                        in
                          check_date date;
                          date

(* Example *)
let test () =
  flprint
    (string_of_date
      {year = 2000; month = 3; day = 16; hour = 13; minute = 2; second = 34; hour_offset = ~-1; minute_offset = 24});
  let d =
    date_of_string "D:199812231952-08'00'"
  in
    Printf.printf "\n%i %i %i %i %i %i %i %i\n" d.year d.month d.day d.hour d.minute d.second d.hour_offset d.minute_offset;
    flprint "\n"