1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker
4    E-mail:        J.Wielemaker@vu.nl
5    WWW:           http://www.swi-prolog.org
6    Copyright (c)  2010-2016, University of Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(sicstus_system,
36	  [ environ/2,			% ?Name, ?Value
37
38	    exec/3,			% +Command, -Streams, -PID
39	    wait/2,			% +PID, -Status
40	    pid/1,			% -PID
41
42	    now/1,			% -TimeStamp
43	    datime/1,			% -DaTime
44	    datime/2,			% +TimeStamp, -DaTime
45	    sleep/1,			% +Seconds
46
47	    shell/0,
48	    shell/1,			% +Command
49	    shell/2,			% +Command, -Status
50
51	    system/0,
52	    system/1,			% +Command
53	    system/2,			% +Command, -Status
54
55	    popen/3,			% +Command, +Mode, -Stream
56
57	    host_name/1,		% -HostName
58
59	    working_directory/2,	% -Old, +New
60	    make_directory/1,		% +DirName
61	    file_exists/1,		% +FileName
62	    delete_file/1,		% +FileName
63	    rename_file/2,		% +Old, +New
64	    mktemp/2,			% +Template, -FileName
65	    tmpnam/1			% -FileName
66	  ]).
67:- use_module(library(process)).
68:- use_module(library(socket)).
69:- use_module(library(shell), [shell/0]).
70
71:- multifile sicstus:rename_module/2.
72
73sicstus:rename_module(system, sicstus_system).
74
75/** <module> SICStus-3 library system
76
77
78
79@tbd	This library is incomplete
80*/
81
82%%	environ(?Name, ?Value) is nondet.
83%
84%	True if Value an atom associated   with the environment variable
85%	Name.
86%
87%	@tbd	Mode -Name is not supported
88
89environ(Name, Value) :-
90	getenv(Name, Value).
91
92
93		 /*******************************
94		 *	      PROCESSES		*
95		 *******************************/
96
97%%	exec(+Command, +Streams, -PID)
98%
99%	SICStus 3 compatible implementation of  exec/3   on  top  of the
100%	SICStus 4 compatible process_create/3.
101%
102%	@bug	The SICStus version for Windows seems to hand Command
103%		directly to CreateProcess(). We hand it to
104%
105%		  ==
106%		  %COMSPEC% /s /c "Command"
107%		  ==
108%
109%		In case of conflict, it is adviced to use
110%		process_create/3
111
112exec(Command, Streams, PID) :-
113	Streams = [In, Out, Error],
114	shell(Shell, Command, Argv),
115	process_create(Shell, Argv,
116		       [ stdin(In),
117			 stdout(Out),
118			 stderr(Error),
119			 process(PID)
120		       ]).
121
122shell(Shell, Command, ['/s', '/c', Command]) :-
123	current_prolog_flag(windows, true), !,
124	getenv('COMSPEC', Shell).
125shell('/bin/sh', Command, ['-c', Command]).
126
127%%	wait(+PID, -Status)
128%
129%	Wait for processes created using exec/3.
130%
131%	@see exec/3
132
133wait(PID, Status) :-
134	process_wait(PID, Status).
135
136%%	pid(-PID)
137%
138%	Process ID of the current process.
139%
140%	@compat sicstus.
141
142pid(PID) :-
143	current_prolog_flag(pid, PID).
144
145%%	now(-When) is det.
146%
147%	Unify when with the current time-stamp
148%
149%	@compat sicstus
150
151now(When) :-
152	get_time(Now),
153	When is integer(Now).
154
155%%	datime(+When, -Datime) is det.
156%
157%	True when Datime is a  datime/6   record  that reflects the time
158%	stamp When.
159%
160%	@compat sicstus
161
162datime(When, datime(Year,Month,Day,Hour,Min,Sec)) :-
163	stamp_date_time(When, date(Year,Month,Day,Hour,Min,SecF,_,_,_), local),
164	Sec is integer(SecF).
165
166%%	datime(-Datime) is det.
167%
168%	Unifies Datime with the current  date   and  time  as a datime/6
169%	record  of  the  form  datime(Year,Month,Day,Hour,Min,Sec).  All
170%	fields are integers.
171%
172%	@compat sicstus
173
174datime(datime(Year,Month,Day,Hour,Min,Sec)) :-
175	get_time(Now),
176	stamp_date_time(Now, date(Year,Month,Day,Hour,Min,SecF,_,_,_), local),
177	Sec is integer(SecF).
178
179
180%%	system.
181%%	system(+Command).
182%%	system(+Command, -Status).
183%
184%	Synomyms for shell/0, shell/1 and shell/2.
185%
186%	@compat sicstus.
187
188system :- shell.
189system(Command) :- shell(Command).
190system(Command, Status) :- shell(Command, Status).
191
192%%	popen(+Command, +Mode, ?Stream)
193%
194%	@compat sicstus
195
196popen(Command, Mode, Stream) :-
197	open(pipe(Command), Mode, Stream).
198
199%%	host_name(-HostName)
200%
201%	@compat sicstus
202%	@see gethostname/1
203
204host_name(HostName) :-
205	gethostname(HostName).
206
207
208		 /*******************************
209		 *	 FILE OPERATIONS	*
210		 *******************************/
211
212%%	mktemp(+Template, -File) is det.
213%
214%	Interface to the Unix function.  This emulation uses
215%	tmp_file/2 and ignores Template.
216%
217%	@compat sicstus
218%	@deprecated This interface is a security-risc.  Use
219%	tmp_file_stream/3.
220
221mktemp(_Template, File) :-
222	tmp_file(mkstemp, File).
223
224%%	tmpnam(-FileName)
225%
226%	Interface to tmpnam(). This emulation uses tmp_file/2.
227%
228%	@compat sicstus
229%	@deprecated This interface is a security-risc.  Use
230%	tmp_file_stream/3.
231
232tmpnam(File) :-
233	tmp_file(tmpnam, File).
234
235%%	file_exists(+FileName) is semidet.
236%
237%	True if a file named FileName exists.
238%
239%	@compat sicstus
240
241file_exists(FileName) :-
242	exists_file(FileName).
243