1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
if (Array.length Sys.argv <> 2) then
(Printf.eprintf "\n Usage: %s conninfo\n" Sys.argv.(0); exit 1);;
let conninfo = Sys.argv.(1);;
open GMain
let file_dialog title =
let name= ref "" in
let sel =
GWindow.file_selection ~title ~modal:true () in
let _ = sel#ok_button#connect#clicked ~callback:
(fun () -> name := sel#get_filename; sel#destroy (); Main.quit ()) in
let _ = sel#cancel_button#connect#clicked ~callback:
(fun () -> sel#destroy (); Main.quit ()) in
sel#show ();
Main.main ();
!name
let show_tuples res =
let window = GWindow.window ~title:"Result (tuples)"
~width:300 ~height:300 () in
let vbox = GPack.vbox
~packing:window#add () in
let button = GButton.button ~label:"Close"
~packing:(vbox#pack ~from:`END) () in
let _ = button#connect#clicked ~callback:window#destroy in
let hbox = GPack.hbox
~packing:vbox#add () in
let sbv = GRange.scrollbar `VERTICAL
~packing:(hbox#pack ~from:`END) () in
let sbh = GRange.scrollbar `HORIZONTAL
~packing:(vbox#pack ~from:`END) () in
let cl = GList.clist
~titles:(res#get_fields_list) ~shadow_type:`OUT
~packing:hbox#add
~vadjustment:sbv#adjustment
~hadjustment:sbh#adjustment
() in
for tuple = 0 to res#ntuples - 1 do
let _ = cl#append (res#get_tuple_list tuple) in ()
done;
cl#columns_autosize();
window#show ()
let show_copy_out conn =
let window = GWindow.window ~title:"Result (copy_out)"
~width:300 ~height:300 () in
let vbox = GPack.vbox
~packing:window#add () in
let button = GButton.button ~label:"Close"
~packing:(vbox#pack ~from:`END) () in
let _ = button#connect#clicked ~callback:window#destroy in
let hbox = GPack.hbox
~packing:vbox#add () in
let sbv = GRange.scrollbar `VERTICAL
~packing:(hbox#pack ~from:`END) () in
let sbh = GRange.scrollbar `HORIZONTAL
~packing:(vbox#pack ~from:`END) () in
let txt = GEdit.text
~packing:hbox#add
~vadjustment:sbv#adjustment
~hadjustment:sbh#adjustment
() in
conn#copy_out (fun s -> txt#insert (s^"\n"));
window#show ()
let main () =
let conn =
new Postgres.connection conninfo in
let window =
GWindow.window ~title:"Queries" ~width:300 ~height:300 () in
let _ = window#connect#destroy ~callback:Main.quit in
let vbox =
GPack.vbox ~border_width:5 ~spacing:10 ~packing:window#add () in
let result = GEdit.text ~editable:false ~packing:vbox#add () in
let text = GEdit.text ~editable:true ~packing:vbox#add ~height:50 () in
let print s =
let _ = result#insert_text s ~pos:(result#length) in ()
in
let rec dump_res () =
match conn#get_result with
| Some res ->
(match res#status with
| Postgres.Result.Tuples_ok -> show_tuples res
| Postgres.Result.Copy_out -> show_copy_out conn
| Postgres.Result.Copy_in ->
let name = file_dialog "Choose file to send" in
if name = "" then
(conn # putline "\\.\n"; conn # endcopy)
else
(let f = open_in name in
conn # copy_in_channel f;
close_in f)
| Postgres.Result.Empty_query ->
print "Empty query\n"
| Postgres.Result.Command_ok ->
print (Printf.sprintf "Command ok [%s]\n" res#cmd_status)
| Postgres.Result.Bad_response ->
print (Printf.sprintf "Bad response : %s\n" res#error);
conn#reset
| Postgres.Result.Nonfatal_error ->
print (Printf.sprintf "Non fatal error : %s\n" res#error);
| Postgres.Result.Fatal_error ->
print (Printf.sprintf "Fatal error : %s\n" res#error)
);
dump_res ()
| None -> ()
in
let query () =
let l = text#length in
let s = text#get_chars ~start:0 ~stop:l in
print "-> "; print s; print "\n";
text#delete_text ~start:0 ~stop:l;
text#set_position 0;
conn#send s;
dump_res ();
print "======\n";
flush stdout
in
let _ = text#event#connect#key_press ~callback:
(fun k ->
if (GdkEvent.Key.keyval k = GdkKeysyms._KP_Enter) then (query (); true)
else false); in
let button = GButton.button ~label:"Exec" ~packing:vbox#add ~height:40 () in
let _ = button#connect#clicked ~callback:query in
window#show ();
let window =
GWindow.window ~title:"Backend notifications" ~width:300 ~height:150 () in
let _ = window#connect#destroy ~callback:Main.quit in
let vbox =
GPack.vbox ~border_width:5 ~packing:window#add () in
let hbox =
GPack.hbox ~packing:vbox#add () in
let sb =
GRange.scrollbar `VERTICAL ~packing:(hbox#pack ~from:`END) () in
let clist =
GList.clist ~titles:["Backend PID";"Notification"] ~shadow_type:`OUT
~packing:hbox#add ~vadjustment:sb#adjustment () in
let hbox = GPack.hbox ~packing:vbox#pack () in
let button_clear = GButton.button ~label:"Clear" ~packing:hbox#add () in
let _ = button_clear#connect#clicked ~callback:clist#clear in
let button_clear = GButton.button ~label:"Hide" ~packing:hbox#add () in
let _ = button_clear#connect#clicked ~callback:window#misc#hide in
let rec dump_notification () =
match conn # notification with
| Some (msg,pid) ->
let _ = clist#append [string_of_int pid; msg] in
window#show ();
dump_notification ()
| None -> ()
in
let _ = Timeout.add ~ms:100
~callback:(
fun () -> conn # consume_input; dump_notification (); true
) in
Main.main ()
let _ =
try main ()
with
| Postgres.Error e -> prerr_endline (Postgres.string_of_error e)
| e -> prerr_endline (Printexc.to_string e)
|
