add a database (LoL)
This commit is contained in:
parent
398bddcd03
commit
08c43cabfc
6
Makefile
6
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
|
||||
|
|
|
@ -0,0 +1,3 @@
|
|||
a bot for tokin'
|
||||
|
||||
requires the following opam packages: irc-client-tls, irc-client-lwt, dokeysto
|
|
@ -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
|
||||
|
24
vantabot.ml
24
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 ())
|
||||
|
|
Loading…
Reference in New Issue