summaryrefslogtreecommitdiff
path: root/module/language/lua/standard/os.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/lua/standard/os.scm')
-rw-r--r--module/language/lua/standard/os.scm108
1 files changed, 108 insertions, 0 deletions
diff --git a/module/language/lua/standard/os.scm b/module/language/lua/standard/os.scm
new file mode 100644
index 000000000..e4155a678
--- /dev/null
+++ b/module/language/lua/standard/os.scm
@@ -0,0 +1,108 @@
+;;; Guile Lua --- os standard library
+
+;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language lua standard os)
+ #:use-module (language lua runtime)
+
+ #:use-module (srfi srfi-98))
+
+(define (clock)
+ (tms:clock (times)))
+
+(define* (date #:optional (format "%c") time)
+ (let* ((utc? (eq? (string-ref format 0) #\!))
+ ;; skip !
+ (format (if utc? (string-copy format 1) format))
+ (stm ((if utc? gmtime localtime) (or time (current-time)))))
+ (if time
+ (begin
+ (assert-number 2 "date" time)
+ (if (string=? format "*t")
+ (let* ((table (make-table)))
+ (rawset table "sec" (tm:sec stm))
+ (rawset table "min" (tm:min stm))
+ (rawset table "hour" (tm:hour stm))
+ (rawset table "month" (+ 1 (tm:mon stm)))
+ (rawset table "year" (+ 1900 (tm:year stm)))
+ (rawset table "wday" (+ 1 (tm:wday stm)))
+ (rawset table "yday" (+ 1 (tm:yday stm)))
+ (rawset table "isdst" (> (tm:isdst stm) 0))
+ table)
+ (strftime format stm)))
+ (strftime format stm))))
+
+(define (difftime t2 t1)
+ (- t2 t1))
+
+(define* (execute #:optional command)
+ (if (not command)
+ 1
+ (system command)))
+
+(define* (exit #:optional (code 0))
+ (primitive-exit code))
+
+(define (getenv varname)
+ (or (get-environment-variable varname) #nil))
+
+(define rename rename-file)
+
+(define (remove filename)
+ (if (file-is-directory? filename)
+ (rmdir filename)
+ (delete-file filename)))
+
+(define* (setlocale locale #:optional (category "all"))
+ (assert-string 2 "setlocale" category)
+ ((@ (guile) setlocale)
+ locale
+ (cond ((string=? category "all") LC_ALL)
+ ((string=? category "collate") LC_COLLATE)
+ ((string=? category "ctype") LC_CTYPE)
+ ((string=? category "messages") LC_MESSAGES)
+ ((string=? category "monetary") LC_MONETARY)
+ ((string=? category "numeric") LC_NUMERIC)
+ ((string=? category "time") LC_TIME))))
+
+(define* (time #:optional table)
+ (if table
+ (begin
+ (assert-table 1 "time" table)
+ (let* ((sec (get-field table "sec" 0))
+ (min (get-field table "min" 0))
+ (hour (get-field table "hour" 12))
+ (day (get-field table "day" -1))
+ (month (- (get-field table "month" -1) 1))
+ (year (- (get-field table "year" -1) 1900))
+ (isdst (get-field table "isdst" 0))
+ (result (make-vector 11 0)))
+ (set-tm:sec result sec)
+ (set-tm:min result min)
+ (set-tm:hour result hour)
+ (set-tm:mday result day)
+ (set-tm:mon result month)
+ (set-tm:year result year)
+ (set-tm:isdst result isdst)
+ (set-tm:zone result "")
+ (car (mktime result)))
+ )
+ (current-time)))
+
+(define tmpname mkstemp!)