From 4abe15892dd8246cd2f46dd3bcc35a199d566a08 Mon Sep 17 00:00:00 2001 From: rich Date: Sat, 9 Sep 2006 15:08:08 +0000 Subject: [PATCH] Much improved (& fixed) program for copying whole hosts across database instances. --- tools/.cvsignore | 2 +- tools/Makefile | 52 +++++ tools/copy_host.ml | 584 +++++++++++++++++++++++++++++++++++++++++++++++++++ tools/copy_page.ml | 42 ---- tools/delete_mail.ml | 86 -------- 5 files changed, 637 insertions(+), 129 deletions(-) create mode 100644 tools/Makefile create mode 100644 tools/copy_host.ml delete mode 100644 tools/copy_page.ml delete mode 100755 tools/delete_mail.ml diff --git a/tools/.cvsignore b/tools/.cvsignore index 4fe4f92..bfc4bc9 100644 --- a/tools/.cvsignore +++ b/tools/.cvsignore @@ -1,3 +1,3 @@ *.cmi *.cmo -copy_page +copy_host diff --git a/tools/Makefile b/tools/Makefile new file mode 100644 index 0000000..55f29e5 --- /dev/null +++ b/tools/Makefile @@ -0,0 +1,52 @@ +# Makefile for COCANWIKI. +# $Id: Makefile,v 1.1 2006/09/09 15:08:08 rich Exp $ + +include ../Makefile.config + +PGOCAML_PP := camlp4o -I +pcre -I +extlib -I $(PGOCAMLDIR) $(OCAMLLIBDIR)/unix.cma $(OCAMLLIBDIR)/pcre/pcre.cma $(OCAMLLIBDIR)/extlib/extLib.cma $(OCAMLLIBDIR)/calendar/calendar.cma pgocaml.cma pa_pgsql.cmo + +OCAMLPACKAGES := -package pcre,extlib,netstring,calendar +OCAMLCFLAGS := $(OCAMLPACKAGES) -I $(PGOCAMLDIR) -pp "$(PGOCAML_PP)" +OCAMLCLIBS := -linkpkg pgocaml.cma + +export PGDATABASE=cocanwiki + +ifeq ($(shell hostname),oirase) +# While compiling on home machine, create a tunnel using +# ssh -L 5430:localhost:5432 towada.merjis.com +export PGHOST=localhost +export PGPORT=5430 +endif + +PROGS := copy_host + +all: $(PROGS) + +copy_host: copy_host.cmo + ocamlfind ocamlc $(OCAMLCFLAGS) $(OCAMLCLIBS) -o $@ $^ + +# For debugging camlp4 macro. +print: + $(PGOCAML_PP) pr_o.cmo copy_host.ml + +clean: + rm -f *~ *.bak core *.cmi *.cmo *.cma copy_host + +%.cmi: %.mli + ocamlfind ocamlc $(OCAMLCFLAGS) -c $< + +%.cmo: %.ml + ocamlfind ocamlc $(OCAMLCFLAGS) -c $< + +dep: .depend +depend: .depend + +.depend: + ocamldep -pp "$(PGOCAML_PP)" \ + *.ml > $@ + +ifeq ($(wildcard .depend),.depend) +include .depend +endif + +.SUFFIXES: .ml .mli .cmi .cmo diff --git a/tools/copy_host.ml b/tools/copy_host.ml new file mode 100644 index 0000000..aef72a9 --- /dev/null +++ b/tools/copy_host.ml @@ -0,0 +1,584 @@ +(* Copy a whole host (site). This can also copy between databases and + * servers. + * + * Use 'copy_host --help' for usage. + * + * $Id: copy_host.ml,v 1.1 2006/09/09 15:08:08 rich Exp $ + *) + +open Printf +open ExtList +open ExtString + +let usage = + "copy_host can be used to copy/duplicate a whole host (site). +It can also copy hosts between databases and database server. + + Please read the instructions below carefully before attempting + to use this program! + +BASIC USAGE + + Duplicate a host on the same (local) database server: + + copy_host -shost mysite.example.com -dhost mycopy.example.com + + Copy a host from the local database server to another. The copy + will have the same canonical and alternate hostnames: + + copy_host -short mysite.example.com -ddbhost anotherdb.example.com + +TERMINOLOGY + +'host': The term used by COCANWIKI to mean a site. Each host has + a single row in the 'hosts' table in the database, and a single + unique hostid. A single COCANWIKI database instance can handle + an unlimited number of hosts. + +'canonical hostname': The standard hostname for a host. See the + hosts.canonical_hostname column. + +'hostname': Any of the hostnames permitted for a host. Most sites + will only have one, the canonical_hostname, but some will have + several names, eg. 'example.com' and 'www.example.com'. See + the 'hostnames' table. + +'source ***', 'destination ***': When copying hosts, you copy + from the source whatever to the destination whatever. + +'database hostname': The name of the server running the PostgreSQL + database. When copying a host between databases, you have a + source database hostname and a destination database hostname. + +'database name': The name of the PostgreSQL database (not the + name of the server, but the name of the database). Usually + 'cocanwiki'. Use the command 'psql -l' to list database + names. + +SELECTING THE SOURCE AND DESTINATION HOSTS + +In general, any parameter beginning with '-s***' refers to the +source and with '-d***' to the destination. + +The '-shost hostname' parameter is required, and it selects the +particular host which you want to copy/duplicate. You may give +either the canonical hostname or one of the alternate hostnames, +since either uniquely identifies the source host you want to +copy. + +'-dhost hostname[,...]' is an optional parameter which specifies +the destination hostnames (canonical and alternates). + + If not given, then the same hostname(s) are used as the source. + This only makes sense when copying a host between database + instances, since a single database instance cannot contain + multiple hosts with the same hostnames. + + If given with a single hostname, then that hostname is used + as the canonical hostname for the copy. + + If given with multiple (comma-separated) hostnames, then + the first one is the canonical hostname and the subsequent + ones are the alternate hostnames, eg: + + -dhost www.example.com,example.com + +SELECTING THE SOURCE AND DESTINATION DATABASE(S) + +'-sdb***' and '-ddb***' parameters can be used to select +different source and destination database instances. The +parameters in question are: + + -sdbhost -ddbhost Database hostname. + -sdbport -ddbport Database port number. + -sdbuser -ddbuser Database username. + -sdbpassword -ddbpassword Database password. + -sdbdatabase -ddbdatabase Database name. + +All except the last two, database name, default to nothing +which means that the usual PostgreSQL method for find the value +is used (ie. first use environment variables like $PGHOST, then +use an internal default, usually the local database and user). + +The database name defaults to 'cocanwiki'. + +It is possible to duplicate a host on the same database instance. +In this case it is probably better not to specify the '-sdb***' +or '-ddb***' parameters, but instead use environment variables, +or run this program on the database server itself. + +OPTIONS +" + +let shost = ref "" +let dhost = ref "" +let sdbhost = ref "" +let ddbhost = ref "" +let sdbport = ref 0 +let ddbport = ref 0 +let sdbuser = ref "" +let ddbuser = ref "" +let sdbpassword = ref "" +let ddbpassword = ref "" +let sdbdatabase = ref "cocanwiki" +let ddbdatabase = ref "cocanwiki" +let dryrun = ref false + +let argspec = [ + "-shost", Arg.Set_string shost, + "Source hostname (required)."; + "-dhost", Arg.Set_string dhost, + "Destination hostname(s) (optional)."; + "-sdbhost", Arg.Set_string sdbhost, + "Source database hostname (optional)."; + "-ddbhost", Arg.Set_string ddbhost, + "Destination database hostname (optional)."; + "-sdbport", Arg.Set_int sdbport, + "Source database port (optional)."; + "-ddbport", Arg.Set_int ddbport, + "Destination database port (optional)."; + "-sdbuser", Arg.Set_string sdbuser, + "Source database user (optional)."; + "-ddbuser", Arg.Set_string ddbuser, + "Destination database user (optional)."; + "-sdbpassword", Arg.Set_string sdbpassword, + "Source database password (optional)."; + "-ddbpassword", Arg.Set_string ddbpassword, + "Destination database password (optional)."; + "-sdbdatabase", Arg.Set_string sdbdatabase, + "Source database name (default: cocanwiki)."; + "-ddbdatabase", Arg.Set_string ddbdatabase, + "Destination database name (default: cocanwiki)."; + "-dryrun", Arg.Set dryrun, + "Rollback database changes at the end."; +] + +let error _ = raise (Arg.Bad "Use --help for help.") + +let () = Arg.parse argspec error usage + +let shost = + match !shost with + | "" -> failwith "-shost is required. Use --help for help." + | s -> s +let dhost = + match !dhost with + | "" -> [] + | s -> String.nsplit s "," +let sdbhost = match !sdbhost with "" -> None | s -> Some s +let ddbhost = match !ddbhost with "" -> None | s -> Some s +let sdbport = match !sdbport with 0 -> None | p -> Some p +let ddbport = match !ddbport with 0 -> None | p -> Some p +let sdbuser = match !sdbuser with "" -> None | s -> Some s +let ddbuser = match !ddbuser with "" -> None | s -> Some s +let sdbpassword = match !sdbpassword with "" -> None | s -> Some s +let ddbpassword = match !ddbpassword with "" -> None | s -> Some s +let sdbdatabase = match !sdbdatabase with "" -> None | s -> Some s +let ddbdatabase = match !ddbdatabase with "" -> None | s -> Some s +let dryrun = !dryrun + +(* Get column names from a table. *) +let columns dbh table_name = + let query = "select * from " ^ table_name in + let name = "columns" in + PGOCaml.prepare dbh ~query ~name (); + let columns = + match PGOCaml.describe_statement dbh ~name () with + | _, Some results -> + List.map (fun { PGOCaml.name = name } -> name) results + | _, None -> assert false in + PGOCaml.close_statement dbh ~name (); + columns + +(* 'select * on table where ...' using the low level interface. *) +let select_all dbh table_name where_clause = + let query = "select * from " ^ table_name ^ + (match where_clause with + | "" -> "" + | where_clause -> " where " ^ where_clause) in + let name = "selectall" in + PGOCaml.prepare dbh ~query ~name (); + let columns = + match PGOCaml.describe_statement dbh ~name () with + | _, Some results -> + List.map (fun { PGOCaml.name = name } -> name) results + | _, None -> assert false in + let rows = PGOCaml.execute dbh ~name ~params:[] () in + PGOCaml.close_statement dbh ~name (); + columns, rows + +(* Functions to remove or update the value in a column. *) +let rec remove_column columns rows col_name = + List.filter ( + fun col_name' -> col_name <> col_name' + ) columns, + List.map ( + fun row -> + List.filter_map ( + fun (col_name', value) -> + if col_name <> col_name' then Some value else None + ) (List.combine columns row) + ) rows + +and update_column columns rows col_name new_value = + columns, + List.map ( + fun row -> + List.map ( + fun (col_name', old_value) -> + if col_name <> col_name' then old_value else new_value + ) (List.combine columns row) + ) rows + +and update_apply_column columns rows col_name f = + columns, + List.map ( + fun row -> + List.map ( + fun (col_name', old_value) -> + if col_name <> col_name' then old_value else f old_value + ) (List.combine columns row) + ) rows + +(* Insert rows into the database table. *) +let insert dbh table_name columns rows = + let query = "insert into " ^ table_name ^ " (" ^ + String.concat ", " columns + ^ ") values (" ^ + String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns) + ^ ")" in + let name = "insertinto" in + PGOCaml.prepare dbh ~query ~name (); + List.iter (fun params -> ignore (PGOCaml.execute dbh ~name ~params ())) rows; + PGOCaml.close_statement dbh ~name () + +(* Insert rows into the database table, returning serial numbers. *) +let insert_serial dbh table_name columns rows serial_col = + let query = "insert into " ^ table_name ^ " (" ^ + String.concat ", " columns + ^ ") values (" ^ + String.concat ", " (List.mapi (fun i _ -> sprintf "$%d" (i+1)) columns) + ^ ")" in + let name = "insertserial" in + PGOCaml.prepare dbh ~query ~name (); + let seq = table_name ^ "_" ^ serial_col ^ "_seq" in + let serials = + List.map ( + fun params -> + ignore (PGOCaml.execute dbh ~name ~params ()); + PGOCaml.serial4 dbh seq + ) rows in + PGOCaml.close_statement dbh ~name (); + serials + +let int32_of_value value = + let value = Option.get value in + Int32.of_string value + +let value_of_int32 i = + let i = Int32.to_string i in + Some i + +let () = + print_endline "Connecting to databases ..."; + print_endline " Source ..."; + let sdbh = + let host = sdbhost in + let port = sdbport in + let user = sdbuser in + let password = sdbpassword in + let database = sdbdatabase in + PGOCaml.connect ?host ?port ?user ?password ?database () in + print_endline " Destination ..."; + let ddbh = + let host = ddbhost in + let port = ddbport in + let user = ddbuser in + let password = ddbpassword in + let database = ddbdatabase in + PGOCaml.connect ?host ?port ?user ?password ?database () in + print_endline "Locate source host ..."; + let shostid = List.hd ( + PGSQL(sdbh) "select hostid from hostnames where name = $shost" + ) in + let scanonical_hostname = List.hd ( + PGSQL(sdbh) "select canonical_hostname from hosts where id = $shostid" + ) in + let shostnames = + PGSQL(sdbh) + "select name from hostnames where hostid = $shostid order by 1" in + printf " shostid = %ld\n" shostid; + printf " scanonical_hostname = %s\n" scanonical_hostname; + printf " shostnames = [ %s ]\n" (String.concat "; " shostnames); + + print_endline "Begin transaction on destination database ..."; + PGOCaml.begin_work ddbh; + PGSQL(ddbh) "set constraints hosts_hostname_cn, pages_redirect_cn deferred"; + + (* Also start a transaction on the source database. We are not + * intending to make any changes, but this transaction ensures that we + * can't because the disconnect at the end of the program will roll any + * we make back. + *) + PGOCaml.begin_work sdbh; + + (* Tables hosts and hostnames are the most complex to copy because + * we may want to update the hostname. + *) + let dcanonical_hostname, dhostnames = + match dhost with + | [] -> scanonical_hostname, shostnames + | x :: xs -> x, xs in + + print_endline "Create new host ..."; + + let columns, rows = + select_all sdbh "hosts" (sprintf "id = %ld" shostid) in + let nr_columns = List.length columns in + assert (nr_columns >= 19); + assert (List.length rows = 1); + let columns, rows = remove_column columns rows "id" in + assert (List.length columns = nr_columns - 1); + assert (List.length rows = 1); + let columns, rows = + update_column columns rows "canonical_hostname" + (Some dcanonical_hostname) in + assert (List.length columns = nr_columns - 1); + assert (List.length rows = 1); + let serials = insert_serial ddbh "hosts" columns rows "id" in + assert (List.length serials = 1); + let dhostid = List.hd serials in + printf " dhostid = %ld\n" dhostid; + + print_endline "Create table hostnames ..."; + List.iter ( + fun hostname -> + printf " adding hostname %s\n" hostname; + PGSQL(ddbh) + "insert into hostnames (hostid, name) values ($dhostid, $hostname)" + ) dhostnames; + + (* Now start copying the tables. + * Not entirely trivial because where a table references another, + * we will need to update the IDs to match the corrected serial + * numbers. + *) + print_endline "Copying table users ..."; + let columns, rows = + select_all sdbh "users" (sprintf "hostid = %ld" shostid) in + assert (List.hd columns = "id"); + let old_ids = List.map int32_of_value (List.map List.hd rows) in + let columns, rows = + remove_column columns rows "id" in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + let new_ids = + insert_serial ddbh "users" columns rows "id" in + + let userid_map = List.combine old_ids new_ids in + + print_endline "Copying tables contacts, contact_emails ..."; + let columns, rows = + select_all sdbh "contacts" (sprintf "hostid = %ld" shostid) in + assert (List.hd columns = "id"); + let old_ids = List.map int32_of_value (List.map List.hd rows) in + let columns, rows = + remove_column columns rows "id" in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + let new_ids = + insert_serial ddbh "contacts" columns rows "id" in + + let map = List.combine old_ids new_ids in + + if old_ids <> [] then ( + let columns, rows = + select_all sdbh "contact_emails" + ("contactid in (" ^ + String.concat ", " (List.map Int32.to_string old_ids) ^ + ")") in + let columns, rows = + update_apply_column columns rows "contactid" + (fun old_id -> + let old_id = int32_of_value old_id in + value_of_int32 (List.assoc old_id map)) in + insert ddbh "contact_emails" columns rows + ); + + print_endline "Copying tables pages, contents ..."; + let columns, rows = + select_all sdbh "pages" (sprintf "hostid = %ld" shostid) in + assert (List.hd columns = "id"); + let old_ids = List.map int32_of_value (List.map List.hd rows) in + let columns, rows = + remove_column columns rows "id" in + let columns, rows = + remove_column columns rows "title_description_fti" in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + let columns, rows = + update_apply_column columns rows "logged_user" + (function + | None -> None + | (Some _) as old_id -> + let old_id = int32_of_value old_id in + value_of_int32 (List.assoc old_id userid_map)) in + let new_ids = + insert_serial ddbh "pages" columns rows "id" in + + let map = List.combine old_ids new_ids in + + if old_ids <> [] then ( + let columns, rows = + select_all sdbh "contents" + ("pageid in (" ^ + String.concat ", " (List.map Int32.to_string old_ids) ^ + ")") in + let columns, rows = remove_column columns rows "id" in + let columns, rows = remove_column columns rows "content_fti" in + let columns, rows = + update_apply_column columns rows "pageid" + (fun old_id -> + let old_id = int32_of_value old_id in + value_of_int32 (List.assoc old_id map)) in + insert ddbh "contents" columns rows + ); + + print_endline "Copying tables messages, msg_references ..."; + let columns, rows = + select_all sdbh "messages" (sprintf "hostid = %ld" shostid) in + assert (List.hd columns = "id"); + let old_ids = List.map int32_of_value (List.map List.hd rows) in + let columns, rows = + remove_column columns rows "id" in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + let new_ids = + insert_serial ddbh "messages" columns rows "id" in + + let map = List.combine old_ids new_ids in + + if old_ids <> [] then ( + let columns, rows = + select_all sdbh "msg_references" + ("message_id in (" ^ + String.concat ", " (List.map Int32.to_string old_ids) ^ + ")") in + let columns, rows = + update_apply_column columns rows "message_id" + (fun old_id -> + let old_id = int32_of_value old_id in + value_of_int32 (List.assoc old_id map)) in + insert ddbh "msg_references" columns rows + ); + + print_endline "Copying table files ..."; + let columns, rows = + select_all sdbh "files" (sprintf "hostid = %ld" shostid) in + let columns, rows = + remove_column columns rows "id" in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + insert ddbh "files" columns rows; + + print_endline "Copying table images ..."; + let columns, rows = + select_all sdbh "images" (sprintf "hostid = %ld" shostid) in + let columns, rows = + remove_column columns rows "id" in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + insert ddbh "images" columns rows; + + print_endline "Copying table sitemenu ..."; + let columns, rows = + select_all sdbh "sitemenu" (sprintf "hostid = %ld" shostid) in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + insert ddbh "sitemenu" columns rows; + + print_endline "Copying table links ..."; + let columns, rows = + select_all sdbh "links" (sprintf "hostid = %ld" shostid) in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + insert ddbh "links" columns rows; + + print_endline "Copying table macros ..."; + let columns, rows = + select_all sdbh "macros" (sprintf "hostid = %ld" shostid) in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + insert ddbh "macros" columns rows; + + print_endline "Copying table page_emails ..."; + let columns, rows = + select_all sdbh "page_emails" (sprintf "hostid = %ld" shostid) in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + insert ddbh "page_emails" columns rows; + + print_endline "Copying table mailing_lists ..."; + let columns, rows = + select_all sdbh "mailing_lists" (sprintf "hostid = %ld" shostid) in + let columns, rows = + update_column columns rows "hostid" (value_of_int32 dhostid) in + insert ddbh "mailing_lists" columns rows; + + (* pending_email_changes and usercookies are only copied if the URL + * will not change, because if the URL does change then there is + * no point copying them because all cookies/email URLs will be + * out of date. + *) + if scanonical_hostname = dcanonical_hostname && userid_map <> [] then ( + let where_clause = + "userid in (" ^ + String.concat ", " + (List.map Int32.to_string (List.map fst userid_map)) ^ + ")" in + + print_endline "Copying table usercookies ..."; + let columns, rows = select_all sdbh "usercookies" where_clause in + let columns, rows = + update_apply_column columns rows "userid" + (function + | None -> None + | (Some _) as old_id -> + let old_id = int32_of_value old_id in + value_of_int32 (List.assoc old_id userid_map)) in + insert ddbh "usercookies" columns rows; + + print_endline "Copying table pending_email_changes ..."; + let columns, rows = select_all sdbh "pending_email_changes" where_clause in + let columns, rows = + update_apply_column columns rows "userid" + (function + | None -> None + | (Some _) as old_id -> + let old_id = int32_of_value old_id in + value_of_int32 (List.assoc old_id userid_map)) in + insert ddbh "pending_email_changes" columns rows; + ); + + (* Note: Tables which are NOT copied: + * + * pg_ts_cfg -- Internal tables used by tsearch2 + * pg_ts_cfgmap -- """" + * pg_ts_dict -- """" + * pg_ts_parser -- """" + * powered_by -- Fixed table. + * recently_visited -- Not worth copying. + * server_settings -- Global configuration table. + * templates -- Fixed table. + * themes -- Fixed table. + *) + + (* Commit or rollback. *) + if dryrun then ( + print_endline "Rolling back database because -dryrun flag was given."; + PGOCaml.rollback ddbh + ) else ( + print_endline "Committing changes ..."; + PGOCaml.commit ddbh; + print_endline "Done." + ) diff --git a/tools/copy_page.ml b/tools/copy_page.ml deleted file mode 100644 index f4ea3e0..0000000 --- a/tools/copy_page.ml +++ /dev/null @@ -1,42 +0,0 @@ -(* Copy a page from one host to another. Note that this only copies - * the text, not any images which may be present. - * $Id: copy_page.ml,v 1.5 2006/08/17 09:11:31 rich Exp $ - * - * Usage: copy_page hostid url new_hostid new_url - *) - -module DB = Dbi_postgres - -let dbh = DB.connect "cocanwiki" - -let old_hostid = int_of_string Sys.argv.(1) -let old_url = Sys.argv.(2) -let new_hostid = int_of_string Sys.argv.(3) -let new_url = Sys.argv.(4) - -let () = - let sth = dbh#prepare_cached - "select id from pages where hostid = ? and url = ?" in - sth#execute [`Int old_hostid; `String old_url]; - let old_pageid = sth#fetch1int () in - - let sth = dbh#prepare_cached - "insert into pages (url, title, description, keywords, noodp, - hostid, redirect, css) - select ? as url, title, description, keywords, noodp, - ? as hostid, redirect, css - from pages - where id = ?" in - sth#execute [`String new_url; `Int new_hostid; `Int old_pageid]; - let new_pageid = sth#serial "pages_id_seq" in - - let sth = dbh#prepare_cached - "insert into contents (pageid, ordering, sectionname, content, - divname, divclass, jsgo) - select ? as pageid, ordering, sectionname, content, - divname, divclass, jsgo - from contents - where pageid = ?" in - sth#execute [`Int new_pageid; `Int old_pageid]; - - dbh#commit () diff --git a/tools/delete_mail.ml b/tools/delete_mail.ml deleted file mode 100755 index 028390e..0000000 --- a/tools/delete_mail.ml +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/bin/ocamlrun /usr/bin/ocaml - -#directory "+pcre";; -#directory "+postgres";; -#directory "+dbi";; -#directory "+extlib";; - -#load "unix.cma";; -#load "pcre.cma";; -#load "postgres.cma";; -#load "dbi.cma";; -#load "dbi_postgres.cmo";; -#load "extLib.cma";; - -open Printf - -module DB = Dbi_postgres - -let hostid = 7 - -let () = - print_endline ("*** warning *** This script deletes all mail from wiki.merjis.com (hostid=" ^ string_of_int hostid ^ ")"); - print_endline "to continue type 'yes'"; - let line = read_line () in - if line <> "yes" then exit 1 - -let dbh = new DB.connection "cocanwiki" - -let () = - let sth = dbh#prepare_cached "select id, subject from messages - where hostid = ?" in - sth#execute [`Int hostid]; - - let msgs = sth#map (function [`Int id; `String subject] -> id, subject - | _ -> assert false) in - - (* Delete the pages. *) - List.iter - (fun (msgid, subject) -> - let title = sprintf "Mail/%s (%d)" subject msgid in - let sth = dbh#prepare_cached "select id, url from pages - where hostid = ? and title = ? - and url is not null" in - sth#execute [`Int hostid; `String title]; - let pageid, url = - match sth#fetch1 () with - [ `Int id; `String url ] -> id, url - | _ -> assert false in - - (* This URL might appear in a few other tables. Look at the - * possible constraints: - * - * pages_redirect_cn (redirect to this page) unlikely - * sitemenu_url_cn (in the site menu) no - * page_emails_url_cn (email notify) possible, but not likely - * links_from_cn (links from) YES - * recently_visited_url_cn (recently_visited) VERY LIKELY - *) - let sth = dbh#prepare_cached "delete from links - where hostid = ? and from_url = ?" in - sth#execute [`Int hostid; `String url]; - let sth = dbh#prepare_cached "delete from recently_visited - where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String url]; - - (* Mark the URL as deleted. What effect this has on the database - * consistency is not really clear, but I think it should be ok. - *) - let sth = dbh#prepare_cached "update pages set url_deleted = url, - url = null - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int pageid] - ) msgs; - - (* Delete the messages. *) - List.iter - (fun (msgid, _) -> - let sth = dbh#prepare_cached "delete from msg_references - where message_id = ?" in - sth#execute [`Int msgid]; - - let sth = dbh#prepare_cached "delete from messages where id = ?" in - sth#execute [`Int msgid] - ) msgs; - - dbh#commit () -- 1.8.3.1