X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Fmail_import.ml;h=ae04ef763f5183dc0fd2e1ec824066f0c2190d0c;hb=cd059731a60fd3d4dcf426430ad26ff227b91910;hp=9e24bfbb3b1e2abb156261a526c379d8e226af74;hpb=e828b148d6338765d7f5ca8f10567d5d9ef00548;p=cocanwiki.git diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml index 9e24bfb..ae04ef7 100644 --- a/scripts/mail_import.ml +++ b/scripts/mail_import.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: mail_import.ml,v 1.9 2005/11/24 14:54:12 rich Exp $ + * $Id: mail_import.ml,v 1.12 2006/03/28 16:24:07 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -43,7 +43,7 @@ let ws_re = Pcre.regexp "\\s+" let comma_re = Pcre.regexp "\\s*,\\s*" let lines_re = Pcre.regexp "\\r?\\n" -let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = +let run r (q : cgi) dbh hostid _ user = let hdr_template = get_template dbh hostid "mail_import_header.txt" in (* Overwrite old messages? *) @@ -96,22 +96,21 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = if Char.code c < 32 then ' ' else c) subject in (* Parse the date field. *) - let date, time = + let message_date = try let date = Netdate.parse date in - let date, time = - { Dbi.year = date.Netdate.year; - Dbi.month = date.Netdate.month; - Dbi.day = date.Netdate.day; }, - { Dbi.hour = date.Netdate.hour; - Dbi.min = date.Netdate.minute; - Dbi.sec = date.Netdate.second; - Dbi.microsec = 0; - Dbi.timezone = Some (date.Netdate.zone / 60); } in - date, time + let cal = Calendar.make + date.Netdate.year + date.Netdate.month + date.Netdate.day + date.Netdate.hour + date.Netdate.minute + date.Netdate.second in + let tz = Time_Zone.UTC_Plus (date.Netdate.zone / 60) in + cal, tz with - Invalid_argument _ -> - failwith ("cannot parse date: " ^ date) in + Invalid_argument _ -> + failwith ("cannot parse date: " ^ date) in (* Find the first thing in the In-Reply-To field which looks like a * message ID. @@ -149,41 +148,38 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = * else 'None' if this is a never-seen-before message. *) let overwrite = - let sth = dbh#prepare_cached "select id from messages - where hostid = ? and inet_message_id = ?" in - sth#execute [`Int hostid; `String inet_message_id]; - try - let id = sth#fetch1int () in - if not overwrite then ( - ok ~title:"Message exists" - dbh hostid q "Message already imported"; - return () - ); - Some id - with - Not_found -> None in + let rows = PGSQL(dbh) + "select id from messages + where hostid = $hostid and inet_message_id = $inet_message_id" in + match rows with + | [id] -> + if not overwrite then ( + ok ~title:"Message exists" + dbh hostid q "Message already imported"; + return () + ); + Some id + | [] -> None + | _ -> assert false in (* Save all of this in the database. *) let msgid = match overwrite with None -> (* Never-seen-before message. *) - let sth = - dbh#prepare_cached - "insert into messages (hostid, subject, inet_message_id, - message_date) values (?, ?, ?, ?)" in - sth#execute [`Int hostid; `String subject; `String inet_message_id; - `Timestamp (date, time)]; - let msgid = Int64.to_int (sth#serial "messages_id_seq") in - - let sth = - dbh#prepare_cached - "insert into msg_references (message_id, inet_message_id, - ordering) values (?, ?, ?)" in + PGSQL(dbh) + "insert into messages (hostid, subject, inet_message_id, + message_date) + values ($hostid, $subject, $inet_message_id, $message_date)"; + let msgid = PGOCaml.serial4 dbh "messages_id_seq" in + let ordering = ref 0 in List.iter (fun inet_message_id -> - incr ordering; let ordering = !ordering in - sth#execute [`Int msgid; `String inet_message_id; - `Int ordering]) references; + incr ordering; let ordering = Int32.of_int !ordering in + PGSQL(dbh) + "insert into msg_references (message_id, + inet_message_id, ordering) + values ($msgid, $inet_message_id, $ordering)" + ) references; msgid @@ -197,7 +193,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = * NB. Do not change this unique title - it is also used during thread * indexing. *) - let title = sprintf "Mail/%s (%d)" subject msgid in + let title = sprintf "Mail/%s (%ld)" subject msgid in (* Choose a suitable URL. *) let url = @@ -219,7 +215,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = match overwrite with | None -> new_page (Title title) | Some _ -> load_page dbh hostid ~url () in - let model = { model with redirect = "" } in + let model = { model with redirect = None } in (* Create the first section (mail header). *) let section0 = @@ -229,11 +225,12 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = hdr_template#set "from" from; hdr_template#set "inet_message_id" inet_message_id; - let yyyy, mm, dd = date.Dbi.year, date.Dbi.month, date.Dbi.day in - hdr_template#set "yyyy" (sprintf "%04d" yyyy); - hdr_template#set "mm" (sprintf "%02d" mm); - hdr_template#set "dd" (sprintf "%02d" dd); - hdr_template#set "short_month" (short_month mm); + let date = fst message_date in + hdr_template#set "yyyy" (Printer.CalendarPrinter.sprint "%Y" date); + hdr_template#set "mm" (Printer.CalendarPrinter.sprint "%m" date); + hdr_template#set "dd" (Printer.CalendarPrinter.sprint "%d" date); + hdr_template#set "short_month" + (Printer.short_name_of_month (Calendar.month date)); let get_table hdr = List.map (fun addr -> [ "addr", Template.VarString addr ]) @@ -248,7 +245,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = hdr_template#to_string in - "", "mail_header", content in + None, Some "mail_header", content in (* Create the second section (mail body). * XXX Very simple. Should be extended to understand attachments and @@ -276,12 +273,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = (* Get all the titles from the database! We're going to exclude * mail messages from this. *) - let sth = - dbh#prepare_cached - "select lower (title) from pages where hostid = ? + let links = + PGSQL(dbh) + "select lower (title) from pages where hostid = $hostid and url is not null and title not like 'Mail/%'" in - sth#execute [`Int hostid]; - let links = sth#map (function [`String s] -> s | _ -> assert false) in + let links = List.map Option.get links in (* This code cannot find titles which are split across multiple lines. * XXX @@ -334,7 +330,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = with Not_found -> "No plain text message body found" in - "Message", "mail_body", content in + Some "Message", Some "mail_body", content in (* Overwrite the first two sections of the current page, regardless of * what they contain. @@ -342,25 +338,27 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = * use the divname to identify the old mail_header and mail_body and * overwrite those, or insert them if they don't exist. *) - let contents = model.contents in + let contents = model.contents_ in let contents = match contents with - [] | [_] -> [ section0; section1 ] - | _ :: _ :: xs -> section0 :: section1 :: xs in - let model = { model with contents = contents } in + | [] | [_] -> [ section0; section1 ] + | _ :: _ :: xs -> section0 :: section1 :: xs in + let model = { model with contents_ = contents } in (* Write the page back. This can throw several exceptions, but we ignore * them because we want to script to fail abruptly if any of these * unexpected conditions arises. *) - save_page dbh hostid ~user ~r model; + ignore (save_page dbh hostid ~user ~r model); (* Rebuild threads? *) if rebuild then - thread_mail dbh hostid ~user ~r date.Dbi.year date.Dbi.month; + thread_mail dbh hostid ~user ~r + (Calendar.year (fst message_date)) + (Date.int_of_month (Calendar.month (fst message_date))); (* Commit to the database. *) - dbh#commit (); + PGOCaml.commit dbh; (* Finish off. *) ok ~title:"Imported"