Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 124 lines (114 sloc) 3.574 kb
3b6e8ecc »
2008-11-07 * sulci/common.ml: Now function make_msg controls a message length and
1 (*
08aac6ad »
2011-11-26 Remove email
2 * (c) 2004-2010 Anastasia Gornostaeva
3b6e8ecc »
2008-11-07 * sulci/common.ml: Now function make_msg controls a message length and
3 *)
cc68359d »
2004-12-09 Added copyright
4
34c9f2c8 »
2004-12-09 initial import
5 open Unix
ff645963 »
2008-12-27 * sulci/logger.ml: Removed
6 open Pcre
ec66144b »
2009-09-03 Ontermediate commit
7 open Netconversion
d166fe2a »
2009-01-04 * sulci/*: Now MUC related API splitted from main API to have a
8 open Hooks
ec66144b »
2009-09-03 Ontermediate commit
9 open Plugin_command
34c9f2c8 »
2004-12-09 initial import
10
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
11 type m =
12 | This
13 | Next
14 | Back
34c9f2c8 »
2004-12-09 initial import
15
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
16 let match_item line item =
17 let len = String.length item in
18 let rec aux_match j =
19 if j = len then
20 if line.[j] = ' ' && line.[succ j] = ' ' then
21 This
22 else
23 Back
24 else if line.[j] = item.[j] then
25 aux_match (succ j)
26 else if Char.code line.[j] > Char.code item.[j] then
27 Back
ec66144b »
2009-09-03 Ontermediate commit
28 else
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
29 Next
ec66144b »
2009-09-03 Ontermediate commit
30 in
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
31 aux_match 0
ec66144b »
2009-09-03 Ontermediate commit
32
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
33 let mueller_search dict idx stuff =
34 let shift =
35 if String.length stuff > 1 then
36 Hashtbl.find idx (String.sub stuff 0 2)
ec66144b »
2009-09-03 Ontermediate commit
37 else
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
38 Hashtbl.find idx (stuff ^ " ")
ec66144b »
2009-09-03 Ontermediate commit
39 in
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
40 let _ = lseek dict shift SEEK_SET in
41 let in_dict = in_channel_of_descr dict in
42 let rec aux_read () =
43 let line = input_line in_dict in
44 match match_item (String.lowercase line) stuff with
45 | This -> line
46 | Next ->
47 aux_read ()
48 | Back ->
49 raise Not_found
50 in
51 aux_read ()
52
53 let format_response text =
54 let r = convert ~in_enc:`Enc_koi8r ~out_enc:`Enc_utf8 text in
55 let r1 = regexp "_([IXV]+)" in
56 let rsp1 = substitute_substrings ~rex:r1
57 ~subst:(fun a -> "\n" ^ get_substring a 1) r in
58 let r2 = regexp "([0-9]\\.)" in
59 let rsp2 = substitute_substrings ~rex:r2
60 ~subst:(fun a -> "\n " ^ get_substring a 1) rsp1 in
61 let r3 = regexp "([a-z]|[0-9]+|_[IVX]+)>" in
62 let rsp3 = substitute_substrings ~rex:r3
63 ~subst:(fun a -> "\n " ^ get_substring a 1 ^ ")") rsp2 in
64 let r4 = regexp ~iflags:(cflags [`UTF8])
65 "([абвгдежзийклмно])>" in
66 let rsp4 = substitute_substrings ~rex:r4
67 ~subst:(fun a -> "\n " ^ get_substring a 1 ^ ")") rsp3 in
68 rsp4
69
70 let mueller dict idx xmpp env kind jid_from text =
ec66144b »
2009-09-03 Ontermediate commit
71 if text = "" then
72 env.env_message xmpp kind jid_from "гы! Что бум переводить?"
73 else
74 let reply =
75 try
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
76 let resp = mueller_search dict idx (String.lowercase text) in
77 format_response resp
ec66144b »
2009-09-03 Ontermediate commit
78 with Not_found -> "Не нашёл :("
79 in
80 env.env_message xmpp kind jid_from reply
81
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
82 let rec read_file f shift saved_part acc =
83 let line = try Some (input_line f) with End_of_file -> None in
84 match line with
85 | None -> List.rev acc
86 | Some l ->
87 let part = String.lowercase (String.sub l 0 2) in
88 let newshift = shift + String.length l + 1 in
89 if part = saved_part then
90 read_file f newshift saved_part acc
91 else
92 read_file f newshift part ((part, shift) :: acc)
93
ec66144b »
2009-09-03 Ontermediate commit
94 let plugin opts =
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
95 let file =
5cba00e9 »
2010-01-15 Tidy
96 try List.assoc "file" (List.assoc "db" opts)
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
97 with Not_found ->
5cba00e9 »
2010-01-15 Tidy
98 raise (Plugin.Error
99 "Please specify <db file='/path/Mueller.koi'/> element in configuration file"
100 ) in
101 let () =
102 if not (Sys.file_exists file) then
103 raise (Plugin.Error (Printf.sprintf "%s does not exists" file)) in
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
104 let hdict = open_in_bin file in
105 let idxs = read_file hdict 0 " " [] in
106 let idx = Hashtbl.create (List.length idxs) in
107 let () =
108 close_in hdict;
109 List.iter (fun (part, shift) -> Hashtbl.add idx part shift) idxs;
110 in
111 add_for_token
112 (fun _opts xmpp ->
113 let dict =
114 try openfile file [O_RDONLY] 0o644
115 with Unix_error (err, _, _) ->
5cba00e9 »
2010-01-15 Tidy
116 raise (Plugin.Error ("Cannot open " ^ file))
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
117 in
118 Plugin_command.add_commands xmpp
119 [("mueller", mueller dict idx)] opts
120 )
ec66144b »
2009-09-03 Ontermediate commit
121
f80f254b »
2009-12-02 More or less working scheme for hooks, not completed
122 let () =
123 Plugin.add_plugin "mueller" plugin
Something went wrong with that request. Please try again.