34
35:- module(rserve,
36 [ r_open/2, 37 r_close/1, 38 r_login/3, 39
40 r_assign/3, 41 r_eval/2, 42 r_eval/3, 43 r_eval_ex/3, 44
45 r_read_file/3, 46 r_remove_file/2, 47
48 r_detach/2, 49 r_resume/2, 50
51 r_server_eval/2, 52 r_server_source/2, 53 r_server_shutdown/1 54 ]). 55:- use_module(r_grammar). 56:- use_module(r_term). 57:- use_module(library(error)). 58
59:- use_foreign_library(foreign(rserve)). 60
61:- multifile
62 r_open_hook/2.
122r_assign(Rserve, VarName, Value) :-
123 r_identifier(VarName), !,
124 r_assign_(Rserve, VarName, Value).
125r_assign(_, VarName, _Value) :-
126 must_be(atom, VarName),
127 domain_error(r_variable_name, VarName).
157r_eval_ex(Connection, Command, Result) :-
158 to_string(Command, CommandS),
159 r_assign($, 'Rserve2.cmd', CommandS),
160 r_eval(Connection,
161 "try(eval(parse(text=Rserve2.cmd)),silent=TRUE)",
162 Result0),
163 r_check_error(Result0),
164 Result = Result0.
165
166to_string(Command, CommandS) :-
167 string(Command), !,
168 CommandS = Command.
169to_string(Command, CommandS) :-
170 string_codes(CommandS, Command).
171
172r_check_error([ErrorString]) :-
173 string(ErrorString),
174 sub_string(ErrorString, 0, _, _, "Error in "),
175 split_string(ErrorString, "\n", "", [Error|Context]), !,
176 throw(error(r_error(Error, Context), _)).
177r_check_error(_).
202
214r_detach(Rserve, Session) :-
215 r_detach_(Rserve, Session),
216 r_close(Rserve).
223r_resume(Rserve, Session) :-
224 r_resume(Rserve, Session, _).
225
226
227
247 250
251prolog:error_message(r_error(Code)) -->
252 { r_error_code(Code, _Id, Message) },
253 [ 'R: ~w'-[Message] ].
254prolog:error_message(r_error(Main, Context)) -->
255 [ 'R: ~w'-[Main] ],
256 error_lines(Context).
257
258error_lines([]) --> [].
259error_lines([""]) --> !.
260error_lines([H|T]) -->
261 [ nl, 'R: ~w'-[H] ],
262 error_lines(T).
263
264
266r_error_code( -1, connect_failed, "Connect failed").
267r_error_code( -2, handshake_failed, "Handshake failed").
268r_error_code( -3, invalid_id, "Invalid id").
269r_error_code( -4, protocol_not_supp, "Protocol not supported").
270r_error_code( -5, not_connected, "Not connected").
271r_error_code( -7, peer_closed, "Peer closed connection").
272r_error_code( -8, malformed_packet, "Malformed packed").
273r_error_code( -9, send_error, "Send error").
274r_error_code(-10, out_of_mem, "Out of memory").
275r_error_code(-11, not_supported, "Not supported").
276r_error_code(-12, io_error, "I/O error").
277r_error_code(-20, auth_unsupported, "Authentication not supported").
278
279r_error_code(0x41, auth_failed, "Authentication failed").
280r_error_code(0x42, conn_broken, "Connection broken").
281r_error_code(0x43, inv_cmd, "Invalid command").
282r_error_code(0x44, inv_par, "Invalid parameters").
283r_error_code(0x45, 'Rerror', "R-error occured").
284r_error_code(0x46, 'IOerror', "I/O error").
285r_error_code(0x47, notOpen, "Read/write on closed file").
286r_error_code(0x48, accessDenied, "Access denied").
287r_error_code(0x49, unsupportedCmd, "Unsupported command").
288r_error_code(0x4a, unknownCmd, "Unknown command").
289r_error_code(0x4b, data_overflow, "Incoming packet is too big").
290r_error_code(0x4c, object_too_big, "Requested object is too big").
291r_error_code(0x4d, out_of_mem, "Out of memory").
292r_error_code(0x4e, ctrl_closed, "Control pipe to master is closed").
293
294r_error_code(0x50, session_busy, "Session is still busy").
295r_error_code(0x51, detach_failed, "Unable to detach seesion").
296
297r_error_code(0x61, disabled, "Feature is disabled").
298r_error_code(0x62, unavailable, "Feature is not present").
299r_error_code(0x63, cryptError, "Crypto-system error").
300r_error_code(0x64, securityClose, "Server-initiated close due to security")
SWI-Prolog Rserve client
This module provides a low-level binding to the Rserve R server process. */