diff --git a/sulci/Makefile b/sulci/Makefile index 183b3c9..24d985f 100644 --- a/sulci/Makefile +++ b/sulci/Makefile @@ -99,7 +99,7 @@ ifeq ($(MUC),yes) endif ifeq ($(PLUGIN_MARKOV),yes) - SOURCES1 += plugin_markov.ml + SOURCES1 += plugin_markov_sql.ml markov_core.ml plugin_markov.ml SQLITE = yes endif @@ -108,12 +108,12 @@ ifeq ($(MUC),yes) endif ifeq ($(PLUGIN_SEEN),yes) - SOURCES1 += plugin_seen.ml + SOURCES1 += plugin_seen_sql.ml plugin_seen.ml SQLITE = yes endif ifeq ($(PLUGIN_TALKERS),yes) - SOURCES1 += plugin_talkers.ml + SOURCES1 += plugin_talkers_sql.ml plugin_talkers.ml SQLITE = yes endif @@ -157,7 +157,7 @@ ifdef XMLSTRING_NETSTRING PACKS += xmlstring_netstring endif ifeq ($(SQLITE), yes) - SOURCES += sqlite_util.ml + SOURCES += sqlite_util.ml sqlgg_traits.ml sqlgg_sqlite3.ml PACKS += sqlite3 endif @@ -172,13 +172,18 @@ RESULT = sulci include ../Makefile.global -all: version.ml nc subdirs +all: gen version.ml nc subdirs version.ml: version.ml.src sed 's/VERSION/$(VERSION)/' version.ml.src > version.ml subdirs: $(SUBDIRS) +gen: plugin_talkers_sql.ml plugin_seen_sql.ml plugin_markov_sql.ml + +plugin_%_sql.ml: plugin_%.sql + sqlgg -gen caml -name Make $< > $@ + $(SUBDIRS): $(MAKE) -C $@ diff --git a/sulci/Makefile.conf b/sulci/Makefile.conf index f1b2cc6..8bc7028 100644 --- a/sulci/Makefile.conf +++ b/sulci/Makefile.conf @@ -3,27 +3,27 @@ MUC=yes PLUGIN_ADMIN=yes PLUGIN_CALC=yes -PLUGIN_CURRENCY=yes -PLUGIN_DICT=yes -PLUGIN_GLOBALSTATS=yes -PLUGIN_GOOGLE=yes -PLUGIN_YANDEX=yes +#PLUGIN_CURRENCY=yes +#PLUGIN_DICT=yes +#PLUGIN_GLOBALSTATS=yes +#PLUGIN_GOOGLE=yes +#PLUGIN_YANDEX=yes PLUGIN_MARKOV=yes -PLUGIN_MISC=yes -PLUGIN_MUELLER=yes +#PLUGIN_MISC=yes +#PLUGIN_MUELLER=yes PLUGIN_PING=yes -PLUGIN_ROULETTE=yes -PLUGIN_TLD=yes +#PLUGIN_ROULETTE=yes +#PLUGIN_TLD=yes PLUGIN_USERINFO=yes -PLUGIN_VOCABULARY=yes -PLUGIN_WEATHER=yes +#PLUGIN_VOCABULARY=yes +#PLUGIN_WEATHER=yes PLUGIN_SEEN=yes PLUGIN_TALKERS=yes -PLUGIN_CERBERUS=yes -PLUGIN_TRANSLATE=yes -PLUGIN_VSEARCH=yes -PLUGIN_VCARD=yes +#PLUGIN_CERBERUS=yes +#PLUGIN_TRANSLATE=yes +#PLUGIN_VSEARCH=yes +#PLUGIN_VCARD=yes #PLUGIN_XMLRPC=yes -PLUGIN_HOSTIP=yes +#PLUGIN_HOSTIP=yes #PLUGIN_1APRIL=yes -PLUGIN_GOOGLE_TRANSLATE=yes +#PLUGIN_GOOGLE_TRANSLATE=yes diff --git a/sulci/_tags b/sulci/_tags index 5bf2e96..6c94a31 100644 --- a/sulci/_tags +++ b/sulci/_tags @@ -23,3 +23,4 @@ : use_sqlite3 : use_netstring +true: use_sqlite3, use_pcre, use_unix, use_extLib diff --git a/sulci/dbconv/dbconv.ml b/sulci/dbconv/dbconv.ml new file mode 100644 index 0000000..9ca9358 --- /dev/null +++ b/sulci/dbconv/dbconv.ml @@ -0,0 +1,20 @@ + +open ExtLib +open Printf + +let main () = + let cin = open_in "list" in + print_endline "BEGIN TRANSACTION;"; + print_endline "CREATE TABLE words (word1 VARCHAR(256), word2 VARCHAR(256), counter INT);"; + let escape = String.replace_chars (function '\'' -> "''" | c -> String.make 1 c) in + let line s = + match String.nsplit s " " with + | [w1;w2;n] -> printf "INSERT INTO words VALUES('%s','%s',%s);\n" (escape w1) (escape w2) n + | _ -> failwith "Bad line" + in + Enum.iter line (Std.input_lines cin); + print_endline "CREATE INDEX word1word2 ON words(word1,word2);"; + print_endline "COMMIT;"; + () + +let () = Printexc.print main () diff --git a/sulci/markov_core.ml b/sulci/markov_core.ml new file mode 100644 index 0000000..e7fc1e2 --- /dev/null +++ b/sulci/markov_core.ml @@ -0,0 +1,128 @@ +(* + * (c) 2004-2009 Anastasia Gornostaeva. + *) + +open Sqlite3 +(* open ExtLib *) + +module Sql = Plugin_markov_sql.Make(Sqlgg_sqlite3) + +(* +let time = Unix.gettimeofday +let print = print_endline +let measure msg f x = + let start = time () in + Std.finally (fun () -> Printf.printf "%s %f\n%!" msg (time () -. start)) f x +*) + +let () = Random.self_init () + +module Index = Map.Make(String) + +let cache_sum cache = Index.fold (fun _ x acc -> acc + !x) !cache 0 +let cache_new_word cache w cnt = cache := Index.add w (ref (Int64.to_int cnt)) !cache + +let fill_cache db = + let cache = ref Index.empty in + Sql.select_by_word1 db "" (cache_new_word cache); +(* printf "%u words totalling %u\n%!" (Index.fold (fun _ _ acc -> acc + 1) !cache 0) (cache_sum ()) *) + cache + +let open_markovdb path (lnode, ldomain) = + if not (Sys.file_exists path) then Unix.mkdir path 0o755; + let file = Filename.concat path (lnode ^ "@" ^ ldomain) in + let db = Sqlite3.db_open file in + ignore (Sql.create_words db); + ignore (Sql.create_index_word1word2 db); + file, (db, fill_cache db) + +exception Found of string + +let seek_cache cache = + match cache_sum cache with + | 0 -> "" + | sum -> let lim = ref (Random.int sum + 1) in + try Index.iter (fun w x -> lim := !lim - !x; if !lim <= 0 then raise (Found w)) !cache; "" with Found w -> w + +let add_cache cache w = + try + incr (Index.find w !cache) + with Not_found -> + cache_new_word cache w 1L + +let seek file (db,cache) w1 = + if w1 = "" then seek_cache cache else + match Sql.count_word1 db w1 with + | None | Some 0L -> "" + | Some sum -> + let sum = Int64.to_int sum in + let lsum = ref (Random.int sum + 1) in + try + Sql.select_by_word1 db w1 (fun w2 cnt -> + lsum := !lsum - (Int64.to_int cnt); + if !lsum <= 0 then raise (Found w2)); + "" + with + Found w2 -> w2 + +(* let seek file db w = measure "seek" (seek file db) w *) + +let add file (db,cache) words = + let update w1 w2 = + if w1 = w2 then () + else + begin + if w1 = "" then add_cache cache w2; + match Sql.select_cond db w1 w2 with + | Some _ -> ignore (Sql.increment db w1 w2) + | None -> ignore (Sql.add_new db w1 w2) + end + in + let rec cycle1 w1 = function + | [] -> update w1 "" + | w2 :: tail -> update w1 w2; cycle1 w2 tail + in + try + cycle1 "" words + with exn -> + Printf.printf "Plugin_markov %s\n%!" (Printexc.to_string exn) + +let chain_limit = ref 20 + +let generate file db = + let rec cycle3 w i acc = + if i = !chain_limit then + String.concat " " (List.rev acc) + else + match seek file db w with + | "" -> String.concat " " (List.rev acc) + | w2 -> cycle3 w2 (i+1) (w2::acc) + in + try + cycle3 "" 0 [] + with exn -> + Printf.printf "Plugin_markov: generate a phrase: %s\n%!" (Printexc.to_string exn); + "" + +let split_words body = + Pcre.split ~pat:"[ \t\n]+" body + +let count (db,_) = + let result = + match Sql.count_all db with + | None -> 9 (* ? *) + | Some r -> Int64.to_int r + in + string_of_int result + +let top (db,_) = + let acc = ref [] in + Sql.select_all_notempty db (fun word1 word2 cnt -> + let r = Printf.sprintf "\n%s | %s | %Lu" word1 word2 cnt in acc:=r::!acc); + let acc = List.rev !acc in + String.concat "" acc + +let close (db,cache) = + ignore (db_close db); + cache := Index.empty + diff --git a/sulci/myocamlbuild.ml b/sulci/myocamlbuild.ml new file mode 100644 index 0000000..71ae81b --- /dev/null +++ b/sulci/myocamlbuild.ml @@ -0,0 +1,29 @@ +open Ocamlbuild_plugin +open Command + +module C = Myocamlbuild_config + +;; + +dispatch begin function +| After_rules -> + + let extern ?name lib = ocaml_lib ~extern:true ~dir:(C.lib lib) (match name with Some s -> s | None -> lib) in + extern "sqlite3"; + extern "pcre"; + extern "extlib" ~name:"extLib"; + + (* + let extlib_dir = C.lib "extlib" in + + ocaml_lib ~extern:true ~dir:extlib_dir "extLib"; + ocaml_lib ~extern:true ~dir:(C.lib "deriving") "deriving"; + ocaml_lib ~extern:true ~dir:(C.lib "oUnit") "oUnit"; + + flag ["ocaml"; "doc"; "use_extLib"] (S[A"-I"; A extlib_dir]); + *) + + () + +| _ -> () +end diff --git a/sulci/myocamlbuild_config.ml b/sulci/myocamlbuild_config.ml new file mode 100644 index 0000000..059ca91 --- /dev/null +++ b/sulci/myocamlbuild_config.ml @@ -0,0 +1,71 @@ +(** + This ocamlbuild plugin will try to find libraries by name using (in order) + - local myocamlbuild.config file + - ocamlfind + + Sample myocamlbuild.config : + +extlib=C:/my/contrib/extlib-1.5.1 +deriving=C:/my/contrib/deriving-0.1.1/lib +oUnit=C:/my/contrib/ounit-1.0.3 + +*) + +(** querying ocamlfind *) + +let chomp s = + let is_nl ch = match ch with | '\n' | '\r' -> true | _ -> false in + let rec cut n = + if n = 0 then 0 else if is_nl s.[n-1] then cut (n-1) else n + in + let ls = String.length s in + let n = cut ls in + if n = ls then s else String.sub s 0 n + +let ocamlfind lib = + let cin = Unix.open_process_in (Printf.sprintf "ocamlfind -query %s" lib) in + let s = chomp (input_line cin) in + (* let s = Filename.quote s in*) + ignore (Unix.close_process_in cin); + s + +(** querying config *) + +let file_lines name = + let l = ref [] in + begin try + let ch = open_in name in + begin try while true do l := input_line ch :: !l done with End_of_file -> () end; + close_in_noerr ch + with + exn -> () + end; + !l + +let read_config name = + let l = file_lines name in + let split s = + let index = String.index s '=' in + (String.sub s 0 index, String.sub s (index+1) ((String.length s) - index - 1)) + in + let split s = try split s with _ -> "","" in + List.map split l + +(** usage *) + +let config = read_config "myocamlbuild.config" +let () = + match config with + | [] -> prerr_endline "No config, will use ocamlfind" + | _ -> prerr_endline "Using config : "; + List.iter (fun (x,y) -> Printf.eprintf "%s=%s\n%!" x y) config + +let lib name = + try + List.assoc name config + with exn -> + try + ocamlfind name + with exn -> + "+" ^ name + diff --git a/sulci/plugin_markov.ml b/sulci/plugin_markov.ml index 2034a16..31ba94f 100644 --- a/sulci/plugin_markov.ml +++ b/sulci/plugin_markov.ml @@ -11,10 +11,8 @@ open Common open Hooks open Muc_types open Muc -open Sqlite3 -open Sqlite_util -let table = "words" +module M = Markov_core type mevent = | MMessage of muc_event * jid * Xml.element * local_env * (Xml.element -> unit) @@ -31,8 +29,6 @@ type t = { module MarkovMap = Map.Make(GID) let markovrooms = ref MarkovMap.empty -let _ = Random.self_init () - let add_queue (m:t) (mevent:mevent) = Mutex.lock m.mutex; Queue.add mevent m.queue; @@ -47,194 +43,47 @@ let take_queue (m:t) = let e = Queue.take m.queue in Mutex.unlock m.mutex; e - -let open_markovdb (lnode, ldomain) = - let path = - try trim (Xml.get_attr_s Config.config + +let open_markovdb ll = + let path = + try trim (Xml.get_attr_s Config.config ~path:["plugins"; "markov"] "dir") with Not_found -> "./markov_db" in - if not (Sys.file_exists path) then Unix.mkdir path 0o755; - let file = Filename.concat path (lnode ^ "@" ^ ldomain) in - let db = Sqlite3.db_open file in - create_table file db - (Printf.sprintf - "SELECT name FROM SQLITE_MASTER WHERE type='table' AND name='%s'" - table) - (Printf.sprintf - "CREATE TABLE %s (word1 varchar(256), word2 varchar(256), counter int); - CREATE INDEX word1word2 ON %s (word1, word2)" - table table); - file, db - -let add file db words = - let rec cycle1 w1 lst = - match lst with - | [] -> ( - let sql1 = Printf.sprintf - "SELECT counter FROM %s WHERE word1=%s AND word2=''" - table (escape w1) in - let sql2 = - Printf.sprintf - "UPDATE %s SET counter=counter+1 WHERE word1=%s AND word2=''" - table (escape w1) in - let sql3 = - Printf.sprintf - "INSERT INTO %s (word1, word2, counter) VALUES(%s, '', 1)" - table ( escape w1) - in - ignore (insert_or_update file db sql1 sql2 sql3) - ) - | w2 :: tail -> ( - if w1 = w2 then - cycle1 w2 tail - else ( - let sql1 = Printf.sprintf - "SELECT counter FROM %s WHERE word1=%s AND word2=%s" - table (escape w1) (escape w2) in - let sql2 = Printf.sprintf - "UPDATE %s SET counter=counter+1 WHERE word1=%s AND word2=%s" - table (escape w1) (escape w2) in - let sql3 = Printf.sprintf - "INSERT INTO %s (word1, word2, counter) VALUES(%s, %s, 1)" - table (escape w1) (escape w2) in - ignore (insert_or_update file db sql1 sql2 sql3); - cycle1 w2 tail - ) - ) - in - try - cycle1 "" words - with exn -> - log#error "Plugin_markov %s" (Printexc.to_string exn) - -let seek file db (w1:string) = - let sum = - match get_one_row file db - (Printf.sprintf "SELECT sum(counter) FROM %s WHERE word1=%s" - table (escape w1)) with - | None -> 0 - | Some r -> Int64.to_int (int64_of_data r.(0)) - in - if sum = 0 then - w1, "" - else - let sql = Printf.sprintf - "SELECT word1, word2, counter FROM %s WHERE word1=%s" - table (escape w1) in - let rec aux_seek lsum stmt = - match step stmt with - | Rc.ROW -> - let i = int_of_string (Data.to_string (column stmt 2)) in - if lsum - i <= 0 then - (Data.to_string (column stmt 0), - Data.to_string (column stmt 1)) - else - aux_seek (lsum - i) stmt - | Rc.DONE -> - w1, "" - | _ -> exit_with_rc file db sql - in - try - let stmt = prepare db sql in - let w1, w2 = aux_seek (Random.int sum + 1) stmt in - if finalize stmt <> Rc.OK then - exit_with_rc file db sql; - w1, w2 - with Sqlite3.Error _ -> - exit_with_rc file db sql - -let chain_limit = ref + M.open_markovdb path ll + +let () = M.chain_limit := (try int_of_string (get_attr_s Config.config ~path:["plugin"; "markov"] "msg_limit") with Not_found -> 20) - -let generate file db word = - let rec cycle3 w i acc = - if i = !chain_limit then - let p = String.concat " " (List.rev acc) in - p - else - let w1, w2 = seek file db w in - if w2 = "" then String.concat " " (List.rev acc) - else cycle3 w2 (i+1) (w2::acc) - in - try - cycle3 word 0 [] - with exn -> - log#error "Plugin_markov: generate a phrase: %s" (Printexc.to_string exn); - "" - -let split_words body = - Pcre.split ~pat:"[ \t\n]+" body - + let process_markov file db event from xml env out = match event with | MUC_message (msg_type, nick, body) -> let room_env = get_room_env from in if from.lresource <> room_env.mynick then - let words = split_words body in - if words = [] then ( - if (msg_type = `Groupchat && nick = room_env.mynick) || - msg_type <> `Groupchat then - make_msg out xml "?" - ) else ( - add file db words; - if (msg_type = `Groupchat && nick = room_env.mynick) || - msg_type <> `Groupchat then - let chain = generate file db "" in - make_msg out xml chain - else - () - ) - else - () + let words = M.split_words body in + M.add file db words; + if (msg_type = `Groupchat && nick = room_env.mynick) || msg_type <> `Groupchat then + make_msg out xml (match words with + | [] -> "?" + | _ -> M.generate file db) | _ -> () - + let rec markov_thread (file, db, m) = (match take_queue m with | MMessage (event, from, xml, env, out) -> process_markov file db event from xml env out | MCount (from, xml, env, out) -> - let sql = Printf.sprintf "SELECT COUNT(*) FROM %s" table in - let result = - match get_one_row file db sql with - | None -> 9 - | Some r -> Int64.to_int (int64_of_data r.(0)) - in - make_msg out xml (string_of_int result) - | MTop (from, xml, env, out) -> ( - let sql = Printf.sprintf - "SELECT word1, word2, counter FROM %s WHERE word1!='' AND word2!='' ORDER BY counter DESC LIMIT 10" table in - let rec aux_top acc stmt = - match step stmt with - | Rc.ROW -> - let r = - Printf.sprintf "\n%s | %s | %s" - (Data.to_string (column stmt 0)) - (Data.to_string (column stmt 1)) - (Data.to_string (column stmt 2)) in - aux_top (r::acc) stmt - | Rc.DONE -> - List.rev acc - | _ -> exit_with_rc file db sql - in - try - let stmt = prepare db sql in - let data = aux_top [] stmt in - make_msg out xml (String.concat "" data) - with - | Sqlite3.Error _ -> - exit_with_rc file db sql - | exn -> - log#error "Plugin_markov: !!!top: %s" (Printexc.to_string exn) - ) - | MStop -> - db_close db; + make_msg out xml (M.count db) + | MTop (from, xml, env, out) -> + make_msg out xml (M.top db) + | MStop -> + M.close db; Thread.exit () ); markov_thread (file, db, m) - + let get_markov_queue room = try MarkovMap.find room !markovrooms @@ -245,7 +94,7 @@ let get_markov_queue room = ignore (Thread.create markov_thread (file, db, m)); markovrooms := MarkovMap.add room m !markovrooms; m - + let markov_chain event from xml env out = match event with | MUC_message _ -> @@ -261,21 +110,21 @@ let markov_chain event from xml env out = !markovrooms; with _ -> ()) | _ -> () - + let markov_count text from xml env out = (try let m = get_markov_queue (from.lnode, from.ldomain) in add_queue m (MCount (from, xml, env, out)) with _ -> ()) - + let markov_top text from xml env out = (try let m = get_markov_queue (from.lnode, from.ldomain) in add_queue m (MTop (from, xml, env, out)) with _ -> ()) - + let _ = register_catcher markov_chain; - register_command "!!!count", markov_count; - register_command "!!!top", markov_top - + register_command "!!!count" markov_count; + register_command "!!!top" markov_top + diff --git a/sulci/plugin_markov.sql b/sulci/plugin_markov.sql new file mode 100644 index 0000000..b00bce2 --- /dev/null +++ b/sulci/plugin_markov.sql @@ -0,0 +1,16 @@ +CREATE TABLE IF NOT EXISTS words (word1 varchar(256), word2 varchar(256), counter int); +CREATE INDEX IF NOT EXISTS word1word2 ON words (word1, word2); +-- @select_cond +SELECT counter FROM words WHERE word1=@w1 AND word2=@w2 LIMIT 1; +-- @increment +UPDATE words SET counter=counter+1 WHERE word1=@w1 AND word2=@w2; +-- @add_new +INSERT INTO words (word1, word2, counter) VALUES(@w1, @w2, 1); +-- @count_word1 +SELECT sum(counter) FROM words WHERE word1=@word LIMIT 1; +-- @select_by_word1 +SELECT word2, counter FROM words WHERE word1=@word; +-- @count_all +SELECT COUNT(*) FROM words LIMIT 1; +-- @select_all_notempty +SELECT word1, word2, counter FROM words WHERE word1!='' AND word2!='' ORDER BY counter DESC LIMIT 10; diff --git a/sulci/plugin_seen.ml b/sulci/plugin_seen.ml index 49935a4..4119573 100644 --- a/sulci/plugin_seen.ml +++ b/sulci/plugin_seen.ml @@ -13,8 +13,6 @@ open Hooks open Muc_types open Muc open Nicks -open Sqlite3 -open Sqlite_util exception Break @@ -23,117 +21,80 @@ let file = ~path:["plugins"; "seen"] "db") with Not_found -> "sulci_users.db" -let table_greeting = "greeting" -let table_users = "users" +module Sql = Plugin_seen_sql.Make(Sqlgg_sqlite3) let db = let db = Sqlite3.db_open file in - create_table file db - (Printf.sprintf - "SELECT name FROM SQLITE_MASTER WHERE type='table' AND name='%s'" - table_greeting) - (Printf.sprintf - "CREATE TABLE %s (jid varchar, room varchar, msg varchar); -CREATE INDEX gr_index ON %s (jid, room)" - table_greeting table_greeting); - create_table file db - (Printf.sprintf - "SELECT name FROM SQLITE_MASTER WHERE type='table' AND name='%s'" - table_users) - (Printf.sprintf - "CREATE TABLE %s (jid varchar, room varchar, nick varchar, last integer, action varchar, reason varchar); - CREATE INDEX users_index on %s (jid, room)" - table_users table_users); - db - + Sql.create_users db; + Sql.create_users_index db; + Sql.create_greeting db; + Sql.create_gr_index db; + db + let cmd_greet = Pcre.regexp ~flags:[`DOTALL; `UTF8] "([^\\s]+)\\s+([^\\s]+)\\s+(.+)" - + let add_greet text from xml env out = if env.env_check_access from "admin" then ( if text <> "" then try let res = Pcre.exec ~rex:cmd_greet ~pos:0 text in let jid = jid_of_string (Pcre.get_substring res 1) in - let jid_s = escape (string_of_jid (bare_jid jid)) in + let jid_s = string_of_jid (bare_jid jid) in let room = jid_of_string (Pcre.get_substring res 2) in - let room_s = escape (string_of_jid (bare_jid room)) in - let greet = escape (Pcre.get_substring res 3) in - let sql1 = Printf.sprintf "SELECT 1 FROM %s WHERE jid=%s AND room=%s" - table_greeting jid_s room_s in - let sql2 = - Printf.sprintf "UPDATE %s SET msg=%s WHERE jid=%s AND room=%s" - table_greeting greet jid_s room_s in - let sql3 = - Printf.sprintf - "INSERT INTO %s (jid, room, msg) VALUES (%s, %s, %s)" - table_greeting jid_s room_s greet in - if (insert_or_update file db sql1 sql2 sql3) then - make_msg out xml - (Lang.get_msg env.env_lang "plugin_seen_greet_updated" []) - else - make_msg out xml (Lang.get_msg env.env_lang "plugin_seen_greet_added" []) + let room_s = string_of_jid (bare_jid room) in + let greet = Pcre.get_substring res 3 in + if Sql.add_greeting db ~jid:jid_s ~room:room_s ~msg:greet then + make_msg out xml (Lang.get_msg env.env_lang "plugin_seen_greet_updated" []) (* or _added ? *) + else + make_msg out xml "Failed to update greeting" with Not_found -> make_msg out xml (Lang.get_msg env.env_lang "plugin_seen_greet_bad_syntax" []) ) else () - + +let bare_string jid = string_of_jid (bare_jid jid) +let item_jid item = match item.jid with None -> "" | Some j -> bare_string j + let catch_seen event from xml env out = match event with - | MUC_join item -> ( - let room_s = string_of_jid (bare_jid from) in - let jid_s = - match item.jid with - | None -> "" - | Some j -> string_of_jid (bare_jid j) - in - let sql = Printf.sprintf "SELECT msg FROM %s WHERE jid=%s AND room=%s" - table_greeting (escape jid_s) (escape room_s) in - match get_one_row file db sql with - | None -> () - | Some r -> - out (make_element "message" ["to", room_s; "type", "groupchat"] - [make_simple_cdata "body" - (Printf.sprintf "[%s] %s" - from.resource (string_of_data r.(0)))] - ) - ) + | MUC_join item -> + let room_s = bare_string from in + let jid_s = item_jid item in + let msg = ref None in + Sql.get_greeting db ~jid:jid_s ~room:room_s (fun s -> msg := Some s); + begin match !msg with + | Some str -> out (make_element "message" ["to", room_s; "type", "groupchat"] + [make_simple_cdata "body" + (Printf.sprintf "[%s] %s" from.resource str)] + ) + | None -> () + end | MUC_leave (_, t, reason, item) -> ( - let cond = + let (check,update) = match item.jid with | None -> - "nick=" ^ escape from.lresource - | Some j -> - "jid=" ^ escape (string_of_jid (bare_jid j)) + let nick = from.lresource in + Sql.get_last_by_nick ~nick, Sql.update_user_by_nick ~nick + | Some j -> + let jid = bare_string j in + Sql.get_last_by_jid ~jid, Sql.update_user_by_jid ~jid in - let room_s = string_of_jid (bare_jid from) in - let last = Int32.to_string (Int32.of_float - (Unix.gettimeofday ())) in + let room = bare_string from in + let last = Int64.of_float (Unix.gettimeofday ()) in let action = match t with | `Normal -> "left" | `Kick -> "kick" | `Ban -> "ban" | `UnMember -> "unmember" in - let sql1 = Printf.sprintf "SELECT last FROM %s where %s AND room=%s" - table_users cond (escape room_s) in - let sql2 = - Printf.sprintf - "UPDATE %s SET last=%s, action=%s, reason=%s WHERE %s AND room=%s" - table_users last (escape action) (escape reason) cond - (escape room_s) in - let sql3 = - Printf.sprintf - "INSERT INTO %s (jid, room, nick, last, action, reason) - VALUES (%s,%s,%s, %s, %s, %s)" - table_users - (escape (match item.jid with - | None -> "" - | Some j -> string_of_jid (bare_jid j))) - (escape room_s) - (escape from.resource) - last (escape action) (escape reason) in - ignore (insert_or_update file db sql1 sql2 sql3) + let exists = ref false in + check db (fun _ -> exists := true) ~room; + if !exists then + update db ~last ~action ~room ~reason + else + Sql.add_user db ~jid:(item_jid item) ~room ~action ~nick:from.resource ~reason ~last; + () ) | _ -> () @@ -183,25 +144,20 @@ let seen text from xml env out = else let room = from.lnode, from.ldomain in let nicks = (get_room_env from).nicks in - let sql = Printf.sprintf - "SELECT jid, last, action, reason FROM %s WHERE nick=%s AND room=%s ORDER BY last DESC LIMIT 1" - table_users - (escape text) - (escape (string_of_jid (bare_jid from))) in let reply = - match get_one_row file db sql with - | Some r -> ( - try - verify_nick text (string_of_data r.(0)) nicks xml env + match Sql.find_user db ~nick:text ~room:(bare_string from) with + | Some (jid,last,action,reason) -> + (try + verify_nick text jid nicks xml env with Not_found -> - let stamp = Int64.to_float (int64_of_data r.(1)) in + let stamp = Int64.to_float last in let diff = Lang.expand_time env.env_lang "seen" (int_of_float (Unix.gettimeofday () -. stamp)) in - if string_of_data r.(3) = "" then + if reason = "" then Lang.get_msg env.env_lang - (match string_of_data r.(2) with + (match action with | "kick" -> "plugin_seen_kicked" | "ban" -> "plugin_seen_banned" | "unmember" -> "plugin_seen_unmembered" @@ -209,7 +165,7 @@ let seen text from xml env out = [text; diff] else Lang.get_msg env.env_lang - (match string_of_data r.(2) with + (match action with | "kick" -> "plugin_seen_kicked_reason" | "ban" -> @@ -218,9 +174,9 @@ let seen text from xml env out = "plugin_seen_unmembered_reason" | _ -> "plugin_seen_left_reason") - [text; diff; string_of_data r.(3)] - ) - | None -> ( + [text; diff; reason] + ) + | None -> if Nicks.mem text nicks then Lang.get_msg env.env_lang "plugin_seen_is_here" [text] else @@ -237,7 +193,6 @@ let seen text from xml env out = [text; String.concat ", " !result] else Lang.get_msg env.env_lang "plugin_seen_never_seen" [text] - ) in make_msg out xml reply else diff --git a/sulci/plugin_seen.sql b/sulci/plugin_seen.sql new file mode 100644 index 0000000..9d1f28d --- /dev/null +++ b/sulci/plugin_seen.sql @@ -0,0 +1,31 @@ +-- @create_greeting +CREATE TABLE IF NOT EXISTS greeting (jid varchar, room varchar, msg varchar); +-- @create_gr_index +CREATE UNIQUE INDEX IF NOT EXISTS gr_index ON greeting (jid, room); + +-- @create_users +CREATE TABLE IF NOT EXISTS users (jid varchar, room varchar, nick varchar, last integer, action varchar, reason varchar); +-- @create_users_index +CREATE INDEX IF NOT EXISTS users_index on users (jid, room); + +-- @get_greeting +SELECT msg FROM greeting WHERE jid=@jid AND room=@room; +-- @add_greeting +INSERT OR REPLACE INTO greeting (jid, room, msg) VALUES; + +-- @get_last_by_nick +SELECT last FROM users where nick=@nick AND room=@room; +-- @get_last_by_jid +SELECT last FROM users where jid=@jid AND room=@room; + +-- @update_user_by_nick +UPDATE users SET last=@last, action=@action, reason=@reason WHERE nick=@nick AND room=@room; +-- @update_user_by_jid +UPDATE users SET last=@last, action=@action, reason=@reason WHERE jid=@jid AND room=@room; + +-- @add_user +INSERT INTO users VALUES; + +-- @find_user +SELECT jid, last, action, reason FROM users WHERE nick=@nick AND room=@room ORDER BY last DESC LIMIT 1; + diff --git a/sulci/plugin_talkers.ml b/sulci/plugin_talkers.ml index 3ac38e0..a40e332 100644 --- a/sulci/plugin_talkers.ml +++ b/sulci/plugin_talkers.ml @@ -11,8 +11,6 @@ open Hooks open Muc_types open Muc open Nicks -open Sqlite3 -open Sqlite_util let length s = Netconversion.ustring_length `Enc_utf8 s @@ -25,23 +23,20 @@ let file = let table = "talkers" +module Sql = Plugin_talkers_sql.Make(Sqlgg_sqlite3) + let db = - let db = db_open file in - create_table file db - (Printf.sprintf - "SELECT name FROM SQLITE_MASTER WHERE type='table' AND name='%s'" table) - (Printf.sprintf - "CREATE TABLE %s (jid varchar, nick varchar, room varchar, words int, me int, sentences int); -CREATE INDEX talkersidx ON %s (jid, room); -CREATE INDEX words_idx ON %s (words)" - table table table); - db - + let db = Sqlite3.db_open file in + Sql.create_talkers db; + Sql.create_index1 db; + Sql.create_index2 db; + db + let talkers event from xml env out = match event with | MUC_message (msg_type, nick, text) -> if msg_type = `Groupchat then - let room_s = escape (string_of_jid (bare_jid from)) in + let room_s = string_of_jid (bare_jid from) in if text <> "" then let room_env = get_room_env from in if from.lresource <> room_env.mynick then @@ -52,68 +47,39 @@ let talkers event from xml env out = (length text > 3 && String.sub text 0 4 = "/me ")) then - 1 else 0 in + 1L else 0L in let jid = (Nicks.find from.lresource room_env.nicks).jid in - let cond = + let (test,update) = match jid with - | None -> "nick=" ^ escape from.lresource - | Some j -> - "jid=" ^ escape (string_of_jid (bare_jid j)) + | None -> let nick = from.lresource in (Sql.test_nick ~nick,Sql.update_by_nick ~nick) + | Some j -> let jid = (string_of_jid (bare_jid j)) in (Sql.test_jid ~jid,Sql.update_by_jid ~jid) in - let sql1 = Printf.sprintf - "SELECT 1 FROM %s WHERE %s AND room=%s" - table cond room_s in - let sql2 = - Printf.sprintf - "UPDATE %s SET words=words+%d, sentences=sentences+%d, me=me+%d WHERE %s AND room=%s" table words 1 me cond room_s in - let sql3 = - Printf.sprintf - "INSERT INTO %s (jid, nick, room, words, me, sentences) VALUES(%s, %s, %s, %d, %d, %d)" - table - (escape (match jid with + let words = Int64.of_int words in + let count = ref 0L in + test db (fun x -> count := x) ~room:room_s; + begin match !count with + | 0L -> Sql.insert_new db + ~jid:(match jid with | None -> "" - | Some j -> string_of_jid (bare_jid j))) - (escape from.resource) - room_s words me 1 - in - ignore (insert_or_update file db sql1 sql2 sql3) + | Some j -> string_of_jid (bare_jid j)) + ~nick:from.resource + ~room:room_s + ~words + ~me + ~sentences:1L + | _ -> update db ~words ~se:1L ~me ~room:room_s + end; + () | _ -> () let cmd_talkers text from xml env out = - let room_s = escape (string_of_jid (bare_jid from)) in - let nick = Stringprep.resourceprep text in - let sql = - Printf.sprintf - "SELECT nick, words, me, sentences FROM %s WHERE room=%s %sORDER BY words DESC, sentences ASC%s" - table room_s - (if text <> "" then "AND nick like " ^ escape nick else "") - (if text = "" then " LIMIT 10" else "") - in - let rec aux_step acc stmt = - match step stmt with - | Rc.ROW -> - aux_step - ((Data.to_string (column stmt 0), - Data.to_string (column stmt 1), - Data.to_string (column stmt 2), - Data.to_string (column stmt 3)) :: acc) stmt - | Rc.DONE -> - if finalize stmt <> Rc.OK then - exit_with_rc file db sql; - List.rev acc - | rc -> - exit_with_rc file db sql - in - let data = - try - let stmt = prepare db sql in - aux_step [] stmt - with - | Sqlite3.Error _ -> - exit_with_rc file db sql - in + let room_s = string_of_jid (bare_jid from) in + let nick = if text = "" then "%" else Stringprep.resourceprep text in + let data = ref [] in + Sql.select_talkers db ~room:room_s ~nick ~limit:10L (fun nick words me se -> data := (nick,words,me,se) :: !data); + let data = List.rev !data in let header = ( Lang.get_msg env.env_lang "plugin_talkers_top_header_man" [], Lang.get_msg env.env_lang "plugin_talkers_top_header_words" [], @@ -140,11 +106,11 @@ let cmd_talkers text from xml env out = | [] -> String.concat "" (List.rev acc) | (nick, words, me, sentences) :: t -> let m = tabs - (length nick / 8) in - cycle t ((Printf.sprintf "%s%s%s\t%s\t%s\t%.2g\n" + cycle t ((Printf.sprintf "%s%s%Lu\t%Lu\t%Lu\t%.2g\n" nick (String.sub tab 0 m) words me sentences - (float_of_string words /. float_of_string sentences) + (Int64.to_float words /. Int64.to_float sentences) ) :: acc) in let r = cycle data [] in diff --git a/sulci/plugin_talkers.sql b/sulci/plugin_talkers.sql new file mode 100644 index 0000000..a388019 --- /dev/null +++ b/sulci/plugin_talkers.sql @@ -0,0 +1,17 @@ +CREATE TABLE IF NOT EXISTS talkers (jid varchar, nick varchar, room varchar, words int, me int, sentences int); +-- @create_index1 +CREATE INDEX IF NOT EXISTS talkersidx ON talkers (jid, room); +-- @create_index2 +CREATE INDEX IF NOT EXISTS words_idx ON talkers (words); +-- @test_nick +SELECT COUNT(*) FROM talkers WHERE nick=@nick AND room=@room; +-- @test_jid +SELECT COUNT(*) FROM talkers WHERE jid=@jid AND room=@room; +-- @update_by_nick +UPDATE talkers SET words=words+@words, sentences=sentences+@se, me=me+@me WHERE nick=@nick AND room=@room; +-- @update_by_jid +UPDATE talkers SET words=words+@words, sentences=sentences+@se, me=me+@me WHERE jid=@jid AND room=@room; +-- @insert_new +INSERT INTO talkers (jid, nick, room, words, me, sentences) VALUES; +-- @select_talkers +SELECT nick, words, me, sentences FROM talkers WHERE room=@room AND nick LIKE @nick ORDER BY words DESC, sentences ASC LIMIT @limit; diff --git a/sulci/sqlgg_sqlite3.ml b/sulci/sqlgg_sqlite3.ml new file mode 100644 index 0000000..9811b45 --- /dev/null +++ b/sulci/sqlgg_sqlite3.ml @@ -0,0 +1,72 @@ +(** sqlgg + ocaml + sqlite3 *) + +open Printf + +module S = Sqlite3 + +type statement = S.stmt +type connection = S.db + +type num = int64 +type text = string +type any = string + +exception Oops of string + +let get_column_Int stmt index = + match S.column stmt index with + | S.Data.INT i -> i + | _ -> raise (Oops (sprintf "get_column_Int %u" index)) + +let get_column_Text stmt index = + let x = S.column stmt index in + S.Data.to_string x + +let test_ok rc = + if rc <> S.Rc.OK then + raise (Oops (sprintf "test_ok %s" (S.Rc.to_string rc))) + +let bind_param d stmt index = + let rc = S.bind stmt (index+1) d in + test_ok rc + +let set_param_null = bind_param S.Data.NULL +let set_param_Text stmt index v = bind_param (S.Data.TEXT v) stmt index +let set_param_Any = set_param_Text +let set_param_Int stmt index v = bind_param (S.Data.INT v) stmt index + +let finally final f x = + let r = + try f x with exn -> final (); raise exn + in + final (); + r + +let select db sql set_params callback = + let stmt = S.prepare db sql in + finally (fun () -> test_ok (S.finalize stmt)) + (fun () -> + set_params stmt; + while S.Rc.ROW = S.step stmt do + callback stmt + done) () + +let execute db sql set_params = + let stmt = S.prepare db sql in + finally (fun () -> test_ok (S.finalize stmt)) + (fun () -> + set_params stmt; + let rc = S.step stmt in + rc = S.Rc.DONE + ) () + +let select1 db sql set_params callback = + let stmt = S.prepare db sql in + finally (fun () -> test_ok (S.finalize stmt)) + (fun () -> + set_params stmt; + if S.Rc.ROW = S.step stmt then + Some (callback stmt) + else + None) () + diff --git a/sulci/sqlgg_traits.ml b/sulci/sqlgg_traits.ml new file mode 100644 index 0000000..1e20a60 --- /dev/null +++ b/sulci/sqlgg_traits.ml @@ -0,0 +1,44 @@ +(** *) + +module type M = sig + + type statement + type connection + + (** datatypes *) + type num = int64 + type text = string + type any = text + + exception Oops of string + + val get_column_Int : statement -> int -> num + val get_column_Text : statement -> int -> text + + (** [set_param_* stmt index val]. [index] is 0-based, + @raise Oops on error *) + val set_param_null : statement -> int -> unit + val set_param_Text : statement -> int -> text -> unit + val set_param_Any : statement -> int -> any -> unit + val set_param_Int : statement -> int -> num -> unit + + (** + Perform query and return results via callback for each row + @raise Oops on error + *) + val select : connection -> string -> (statement -> unit) -> (statement -> unit) -> unit + + (** + Perform query and return first row if available + @raise Oops on error + *) + val select1 : connection -> string -> (statement -> unit) -> (statement -> 'b) -> 'b option + + (** Execute non-query. + @raise Oops on error + @return true if successful + *) + val execute : connection -> string -> (statement -> unit) -> bool + +end + diff --git a/sulci/sulci.ml b/sulci/sulci.ml index c07b1fe..93ac211 100644 --- a/sulci/sulci.ml +++ b/sulci/sulci.ml @@ -119,6 +119,7 @@ let _ = Pervasives.exit 127 | exn -> log#error "sulci.ml: %s" (Printexc.to_string exn); + Printexc.print_backtrace stderr; log#error "Probably it is a bug, please send me a bugreport" in reconnect count diff --git a/sulci/test.ml b/sulci/test.ml new file mode 100644 index 0000000..1e81c9d --- /dev/null +++ b/sulci/test.ml @@ -0,0 +1,22 @@ + +open Markov_core + +let (file,db) = open_markovdb "markov.db" ("test","room") +let print = print_endline + +let main () = + while true do + match input_line stdin with + | "!exit" -> ignore (close db); failwith "Exit" + | "!top" -> print (top db) + | "!count" -> print (count db) + | "!loop" -> + let start = Unix.gettimeofday () in + let x = ref 0 in + while !x < 10 do print (generate file db ""); incr x done; + let secs = Unix.gettimeofday() -. start in + Printf.printf "%f/%u = %f sec per phrase\n%!" secs !x (secs /. (float_of_int !x)) + | s -> print (process file db s) + done + +let () = Printexc.print main ()