add a database (LoL)

Makefile

@@ -1,9 +1,9 @@
-SOURCES = irccolors.ml vantabot.ml
+SOURCES = irccolors.ml store.ml vantabot.ml
 RESULT  = vantabot
-PACKS = lwt,irc-client,irc-client-lwt,irc-client-tls
+PACKS = lwt,irc-client,irc-client-lwt,irc-client-tls,dokeysto
 THREADS = yes
 UNIX = yes
 
-all: native-code
+all: byte-code native-code
 
 -include OCamlMakefile

README.md

@@ -0,0 +1,3 @@
+a bot for tokin'
+
+requires the following opam packages: irc-client-tls, irc-client-lwt, dokeysto

store.ml

@@ -0,0 +1,28 @@
+(** top-level function: `register_nick` *)
+module Rwdb = Dokeysto.Db.RW
+
+let get_db (db : string) : Rwdb.t =
+  let open Unix in
+  let already_exists =
+    try access db [F_OK]; true
+    with Unix_error(ENOENT,_,_) -> false in
+  if already_exists
+  then Rwdb.open_existing db
+  else Rwdb.create db
+
+let release_db (h : Rwdb.t) : unit = Rwdb.sync h; Rwdb.close h
+
+let try_finalize f x finally y = let res = try f x with exn -> finally y; raise exn in finally y; res
+
+let inc_nick_value (h : Rwdb.t) (nick : string) : unit =
+  if Rwdb.mem h nick
+  then let n = int_of_string (Rwdb.find h nick) in
+       Rwdb.replace h nick (string_of_int (n+1))
+  else Rwdb.add h nick "1"
+
+
+let register_nick (db : string) (nick : string) =
+  let h = get_db db in
+  try_finalize (inc_nick_value h) nick
+    release_db h
+  

vantabot.ml

@@ -1,3 +1,4 @@
+(* for tls support replace [Irc_client_lwt] with [Irc_client_tls] *)
 open Lwt
 open Irccolors
 module C = Irc_client_tls
@@ -8,20 +9,24 @@ let formatf = Printf.sprintf
 (***********************************)
 (** * Options *)
 
-let host = ref "irc.tilde.chat"
+let host = ref "localhost"
 let port = ref 6697
 let realname = ":3"
 let nick = ref "vantabot"
-let channel = ref "#aa00"
+let channel = ref "#bots"
 let username = nick
 let sleeptime = ref 30.
 let countdown = ref 5
+let db = ref "toke.db"
 
 let options = Arg.align
   [ "-host", Arg.Set_string host, " server host name (default: " ^ !host ^ ")"
   ; "-port", Arg.Set_int port, " server port (default: " ^ string_of_int !port ^ ")"
   ; "-chan", Arg.Set_string channel, " target channel (default: " ^ !channel ^ ")"
   ; "-nick", Arg.Set_string nick, " nick prefix (default: " ^ !nick ^ ")"
+  ; "-sleeptime", Arg.Set_float sleeptime, " time period for joining the toke call, in seconds (default: " ^ string_of_float !sleeptime ^ ")"
+  ; "-countdown", Arg.Set_int countdown, " countdown, in seconds (default: " ^ string_of_int !countdown ^ ")"
+  ; "-db", Arg.Set_string db, " database file, will be created if does not exist (default: " ^ !db ^ ")"
   ]
 
 let sendmsg connection m = C.send_privmsg ~connection ~target:!channel ~message:(color_text ~fg:Green ~bg:Black m)
@@ -39,9 +44,11 @@ let push_toker t =
 
 let tokeplz () =
   let r = String.concat " " !tokers in
-  tokers := [];
   "SMOKE NOW " ^ r
 
+let inc_tokers_count () =
+  List.iter (Store.register_nick !db) !tokers
+
 
 let leaf = [
 "        W        ";
@@ -66,8 +73,13 @@ let start_toke connection =
   let rec toker_thread n conn =
     if n = 0
     then begin
-        sendmsg connection (tokeplz ())
-        >>= fun () -> toke_in_progress := false; show_leaf connection
+        let msg = tokeplz () in 
+        inc_tokers_count ();
+        tokers := [];
+        sendmsg connection msg
+        >>= fun () ->
+        toke_in_progress := false;        
+        show_leaf connection
       end
     else begin
         sendmsg connection (color_text ~bg:Black ~fg:White (formatf "ready in %i..." n))
@@ -153,5 +165,5 @@ let lwt_main () =
     ()
 
 let _ =
-  Arg.parse options (fun _ -> ()) "<vantabot> [options]\nNOTE: SSL only";
+  Arg.parse options (fun _ -> ()) "<vantabot> [options]\n";
   Lwt_main.run (lwt_main ())