languages/lua/src/lib/luaos.pir

   1 # Copyright (C) 2005-2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 lib/luaos.pir - Lua Operating System Library
   7
   8 =head1 DESCRIPTION
   9
  10 This library is implemented through table C<os>.
  11
  12 See "Lua 5.1 Reference Manual", section 5.8 "Operating System Facilities",
  13 L<http://www.lua.org/manual/5.1/manual.html#5.8>.
  14
  15 =head2 Functions
  16
  17 =over 4
  18
  19 =cut
  20
  21 .HLL 'Lua', 'lua_group'
  22 .namespace [ 'Lua::os' ]
  23
  24 .sub 'luaopen_os'
  25 #    print "init Lua OS\n"
  26
  27     .local pmc _lua__GLOBAL
  28     _lua__GLOBAL = get_hll_global '_G'
  29     new $P1, 'LuaString'
  30
  31     .local pmc _os
  32     new _os, 'LuaTable'
  33     set $P1, 'os'
  34     _lua__GLOBAL[$P1] = _os
  35
  36     lua_register($P1, _os)
  37
  38     .const .Sub _os_clock = 'clock'
  39     _os_clock.'setfenv'(_lua__GLOBAL)
  40     set $P1, 'clock'
  41     _os[$P1] = _os_clock
  42
  43     .const .Sub _os_date = 'date'
  44     _os_date.'setfenv'(_lua__GLOBAL)
  45     set $P1, 'date'
  46     _os[$P1] = _os_date
  47
  48     .const .Sub _os_difftime = 'difftime'
  49     _os_difftime.'setfenv'(_lua__GLOBAL)
  50     set $P1, 'difftime'
  51     _os[$P1] = _os_difftime
  52
  53     .const .Sub _os_execute = 'execute'
  54     _os_execute.'setfenv'(_lua__GLOBAL)
  55     set $P1, 'execute'
  56     _os[$P1] = _os_execute
  57
  58     .const .Sub _os_exit = 'exit'
  59     _os_exit.'setfenv'(_lua__GLOBAL)
  60     set $P1, 'exit'
  61     _os[$P1] = _os_exit
  62
  63     .const .Sub _os_getenv = 'getenv'
  64     _os_getenv.'setfenv'(_lua__GLOBAL)
  65     set $P1, 'getenv'
  66     _os[$P1] = _os_getenv
  67
  68     .const .Sub _os_remove = 'remove'
  69     _os_remove.'setfenv'(_lua__GLOBAL)
  70     set $P1, 'remove'
  71     _os[$P1] = _os_remove
  72
  73     .const .Sub _os_rename = 'rename'
  74     _os_rename.'setfenv'(_lua__GLOBAL)
  75     set $P1, 'rename'
  76     _os[$P1] = _os_rename
  77
  78     .const .Sub _os_setlocale = 'setlocale'
  79     _os_setlocale.'setfenv'(_lua__GLOBAL)
  80     set $P1, 'setlocale'
  81     _os[$P1] = _os_setlocale
  82
  83     .const .Sub _os_time = 'time'
  84     _os_time.'setfenv'(_lua__GLOBAL)
  85     set $P1, 'time'
  86     _os[$P1] = _os_time
  87
  88     .const .Sub _os_tmpname = 'tmpname'
  89     _os_tmpname.'setfenv'(_lua__GLOBAL)
  90     set $P1, 'tmpname'
  91     _os[$P1] = _os_tmpname
  92
  93 .end
  94
  95
  96 =item C<os.clock ()>
  97
  98 Returns an approximation of the amount in seconds of CPU time used by the
  99 program.
 100
 101 =cut
 102
 103 .sub 'clock' :anon
 104     .param pmc extra :slurpy
 105     .local pmc res
 106     new $P0, 'Lua'
 107     res = $P0.'clock'()
 108     .return (res)
 109 .end
 110
 111
 112 =item C<os.date ([format [, time]])>
 113
 114 Returns a string or a table containing date and time, formatted according to
 115 the given string C<format>.
 116
 117 If the C<time> argument is present, this is the time to be formatted (see
 118 the C<os.time> function for a description of this value). Otherwise, C<date>
 119 formats the current time.
 120
 121 If C<format> starts with C<‘!’>, then the date is formatted in Coordinated
 122 Universal Time. After that optional character, if C<format> is C<*t>, then
 123 C<date> returns a table with the following fields: C<year> (four digits),
 124 C<month> (1-12), C<day> (1-31), C<hour> (0-23), C<min> (0-59), C<sec> (0-61),
 125 C<wday> (weekday, Sunday is 1), C<yday> (day of the year), and C<isdst>
 126 (daylight saving flag, a boolean).
 127
 128 If C<format> is not C<*t>, then C<date> returns the date as a string,
 129 formatted according with the same rules as the C function C<strftime>.
 130
 131 When called without arguments, C<date> returns a reasonable date and time
 132 representation that depends on the host system and on the current locale
 133 (that is, C<os.date()> is equivalent to C<os.date("%c")>).
 134
 135 =cut
 136
 137 .include 'tm.pasm'
 138
 139 .sub 'date' :anon
 140     .param pmc format :optional
 141     .param pmc time_ :optional
 142     .param pmc extra :slurpy
 143     .local pmc res
 144     .local int t
 145     $S1 = lua_optstring(1, format, '%c')
 146     $I0 = time
 147     t = lua_optint(2, time_, $I0)
 148     $S0 = substr $S1, 0, 1
 149     unless $S0 == '!' goto L1
 150     $P0 = decodetime t
 151     $S1 = substr $S1, 1
 152     goto L2
 153   L1:
 154     $P0 = decodelocaltime t
 155   L2:
 156     unless null $P0 goto L3
 157     new res, 'LuaNil'
 158     .return (res)
 159   L3:
 160     unless $S1 == '*t' goto L4
 161     new res, 'LuaTable'
 162     new $P1, 'LuaString'
 163     new $P2, 'LuaNumber'
 164     set $P1, 'sec'
 165     $I0 = $P0[.TM_SEC]
 166     set $P2, $I0
 167     res[$P1] = $P2
 168     set $P1, 'min'
 169     $I0 = $P0[.TM_MIN]
 170     set $P2, $I0
 171     res[$P1] = $P2
 172     set $P1, 'hour'
 173     $I0 = $P0[.TM_HOUR]
 174     set $P2, $I0
 175     res[$P1] = $P2
 176     set $P1, 'day'
 177     $I0 = $P0[.TM_MDAY]
 178     set $P2, $I0
 179     res[$P1] = $P2
 180     set $P1, 'month'
 181     $I0 = $P0[.TM_MON]
 182     set $P2, $I0
 183     res[$P1] = $P2
 184     set $P1, 'year'
 185     $I0 = $P0[.TM_YEAR]
 186     set $P2, $I0
 187     res[$P1] = $P2
 188     set $P1, 'wday'
 189     $I0 = $P0[.TM_WDAY]
 190     inc $I0
 191     set $P2, $I0
 192     res[$P1] = $P2
 193     set $P1, 'yday'
 194     $I0 = $P0[.TM_YDAY]
 195     inc $I0
 196     set $P2, $I0
 197     res[$P1] = $P2
 198     new $P2, 'LuaBoolean'
 199     set $P1, 'isdst'
 200     $I0 = $P0[.TM_ISDST]
 201     set $P2, $I0
 202     res[$P1] = $P2
 203     .return (res)
 204   L4:
 205     .local string b
 206     .local int idx
 207     b = ''
 208     idx = 0
 209     $I1 = length $S1
 210     new $P1, 'Lua'
 211   L5:
 212     unless idx < $I1 goto L6
 213     $S0 = substr $S1, idx, 1
 214     if $S0 != '%' goto L7
 215     inc idx
 216     if idx == $I1 goto L7
 217     $S0 = substr $S1, idx, 1
 218     $S2 = '%' . $S0
 219     $S0 = $P1.'strftime'($S2, $P0)
 220   L7:
 221     b .= $S0
 222     inc idx
 223     goto L5
 224   L6:
 225     new res, 'LuaString'
 226     set res, b
 227     .return (res)
 228 .end
 229
 230
 231 =item C<os.difftime (t2, t1)>
 232
 233 Returns the number of seconds from time C<t1> to time C<t2>. In Posix,
 234 Windows, and some other systems, this value is exactly C<t2-t1>.
 235
 236 =cut
 237
 238 .sub 'difftime' :anon
 239     .param pmc t2 :optional
 240     .param pmc t1 :optional
 241     .param pmc extra :slurpy
 242     .local pmc res
 243     $I2 = lua_checknumber(1, t2)
 244     $I1 = lua_optint(2, t1, 0)
 245     $I0 = $I2 - $I1
 246     new res, 'LuaNumber'
 247     set res, $I0
 248     .return (res)
 249 .end
 250
 251
 252 =item C<os.execute ([command])>
 253
 254 This function is equivalent to the C function C<system>. It passes C<command>
 255 to be executed by an operating system shell. It returns a status code, which
 256 is system-dependent.
 257
 258 This function is equivalent to the C function C<system>. It passes C<command>
 259 to be executed by an operating system shell. It returns a status code, which
 260 is system-dependent. If C<command> is absent, then it returns nonzero if a
 261 shell is available and zero otherwise.
 262
 263 =cut
 264
 265 .sub 'execute' :anon
 266     .param pmc command :optional
 267     .param pmc extra :slurpy
 268     .local pmc res
 269     $S1 = lua_optstring(1, command, '')
 270     unless $S1 == '' goto L1
 271     $I0 = 1
 272     goto L2
 273   L1:
 274     $I0 = spawnw $S1
 275     $I0 = $I0 / 256
 276   L2:
 277     new res, 'LuaNumber'
 278     res = $I0
 279     .return (res)
 280 .end
 281
 282
 283 =item C<os.exit ([code])>
 284
 285 Calls the C function C<exit>, with an optional C<code>, to terminate the host
 286 program. The default value for C<code> is the success code.
 287
 288 =cut
 289
 290 .sub 'exit' :anon
 291     .param pmc code :optional
 292     .param pmc extra :slurpy
 293     $I1 = lua_optint(1, code, 0)
 294     exit $I1
 295 .end
 296
 297
 298 =item C<os.getenv (varname)>
 299
 300 Returns the value of the process environment variable C<varname>, or B<nil>
 301 if the variable is not defined.
 302
 303 =cut
 304
 305 .sub 'getenv' :anon
 306     .param pmc varname :optional
 307     .param pmc extra :slurpy
 308     .local pmc res
 309     $S1 = lua_checkstring(1, varname)
 310     new $P0, 'Env'
 311     $S0 = $P0[$S1]
 312     if $S0 goto L1
 313     new res, 'LuaNil'
 314     .return (res)
 315   L1:
 316     new res, 'LuaString'
 317     set res, $S0
 318     .return (res)
 319 .end
 320
 321
 322 =item C<os.remove (filename)>
 323
 324 Deletes the file or directory with the given name. Directories must be empty
 325 to be removed. If this function fails, it returns B<nil>, plus a string
 326 describing the error.
 327
 328 =cut
 329
 330 .sub 'remove' :anon
 331     .param pmc filename :optional
 332     .param pmc extra :slurpy
 333     .local pmc res
 334     $S1 = lua_checkstring(1, filename)
 335     $S0 = $S1
 336     new $P0, 'OS'
 337     push_eh _handler
 338     $P0.'rm'($S1)
 339     new res, 'LuaBoolean'
 340     set res, 1
 341     .return (res)
 342   _handler:
 343     .local pmc nil
 344     .local pmc msg
 345     .local pmc e
 346     .local string s
 347     .get_results (e, s)
 348     concat $S0, ': '
 349     concat $S0, s
 350     new nil, 'LuaNil'
 351     new msg, 'LuaString'
 352     set msg, $S0
 353     .return (nil, msg)
 354 .end
 355
 356
 357 =item C<os.rename (oldname, newname)>
 358
 359 Renames file or directory named C<oldname> to C<newname>. If this function
 360 fails, it returns B<nil>, plus a string describing the error.
 361
 362 =cut
 363
 364 .sub 'rename' :anon
 365     .param pmc oldname :optional
 366     .param pmc newname :optional
 367     .param pmc extra :slurpy
 368     .local pmc res
 369     $S1 = lua_checkstring(1, oldname)
 370     $S0 = $S1
 371     $S2 = lua_checkstring(2, newname)
 372     new $P0, 'OS'
 373     push_eh _handler
 374     $P0.'rename'($S1, $S2)
 375     new res, 'LuaBoolean'
 376     set res, 1
 377     .return (res)
 378   _handler:
 379     .local pmc nil
 380     .local pmc msg
 381     .local pmc e
 382     .local string s
 383     .get_results (e, s)
 384     concat $S0, ': '
 385     concat $S0, s
 386     new nil, 'LuaNil'
 387     new msg, 'LuaString'
 388     set msg, $S0
 389     .return (nil, msg)
 390 .end
 391
 392
 393 =item C<os.setlocale (locale [, category])>
 394
 395 Sets the current locale of the program. C<locale> is a string specifying a
 396 locale; C<category> is an optional string describing which category to change:
 397 C<"all">, C<"collate">, C<"ctype">, C<"monetary">, C<"numeric">, or C<"time">;
 398 the default category is C<"all">. The function returns the name of the new
 399 locale, or B<nil> if the request cannot be honored.
 400
 401 =cut
 402
 403 .sub 'setlocale' :anon
 404     .param pmc locale :optional
 405     .param pmc category :optional
 406     .param pmc extra :slurpy
 407     .local pmc res
 408     $S1 = lua_optstring(1, locale)
 409     $S2 = lua_optstring(2, category, 'all')
 410     $I2 = lua_checkoption(2, $S2, 'all collate ctype monetary numeric time')
 411     new $P0, 'Lua'
 412     res = $P0.'setlocale'($I2, $S1)
 413     .return (res)
 414 .end
 415
 416
 417 =item C<os.time ([table])>
 418
 419 Returns the current time when called without arguments, or a time representing
 420 the date and time specified by the given table. This table must have fields
 421 C<year>, C<month>, and C<day>, and may have fields C<hour>, C<min>, C<sec>,
 422 and C<isdst> (for a description of these fields, see the C<os.date> function).
 423
 424 The returned value is a number, whose meaning depends on your system. In
 425 Posix, Windows, and some other systems, this number counts the number of
 426 seconds since some given start time (the "epoch"). In other systems, the
 427 meaning is not specified, and the number returned by C<time> can be used only
 428 as an argument to C<date> and C<difftime>.
 429
 430 =cut
 431
 432 .sub 'time' :anon
 433     .param pmc table :optional
 434     .param pmc extra :slurpy
 435     .local pmc res
 436     if null table goto L1
 437     $I0 = isa table, 'LuaNil'
 438     unless $I0 goto L2
 439   L1:
 440     $I0 = time
 441     new res, 'LuaNumber'
 442     set res, $I0
 443     .return (res)
 444   L2:
 445     lua_checktype(1, table, 'table')
 446     new $P0, 'FixedIntegerArray'
 447     set $P0, 9
 448     $I0 = getfield(table, 'sec', 0)
 449     set $P0[.TM_SEC], $I0
 450     $I0 = getfield(table, 'min', 0)
 451     set $P0[.TM_MIN], $I0
 452     $I0 = getfield(table, 'hour', 12)
 453     set $P0[.TM_HOUR], $I0
 454     $I0 = getfield(table, 'day', -1)
 455     set $P0[.TM_MDAY], $I0
 456     $I0 = getfield(table, 'month', -1)
 457     $I0 -= 1
 458     set $P0[.TM_MON], $I0
 459     $I0 = getfield(table, 'year', -1)
 460     $I0 -= 1900
 461     set $P0[.TM_YEAR], $I0
 462     $I0 = getboolfield(table, 'isdst')
 463     set $P0[.TM_ISDST], $I0
 464     new $P1, 'Lua'
 465     res = $P1.'mktime'($P0)
 466     .return (res)
 467 .end
 468
 469 .sub 'getfield' :anon
 470     .param pmc t
 471     .param string key
 472     .param int d
 473     .local int res
 474     new $P1, 'LuaString'
 475     set $P1, key
 476     $P0 = t[$P1]
 477     $P0 = $P0.'tonumber'()
 478     $I0 = isa $P0, 'LuaNumber'
 479     unless $I0 goto L1
 480     res = $P0
 481     goto L2
 482   L1:
 483     unless d < 0 goto L3
 484     lua_error("field '", key, "' missing in date table")
 485   L3:
 486     res = d
 487   L2:
 488     .return (res)
 489 .end
 490
 491 .sub 'getboolfield' :anon
 492     .param pmc t
 493     .param string key
 494     .local int res
 495     new $P1, 'LuaString'
 496     set $P1, key
 497     $P0 = t[$P1]
 498     $I0 = isa $P0, 'LuaNil'
 499     unless $I0 goto L1
 500     res = -1
 501     goto L2
 502   L1:
 503     res = istrue $P0
 504   L2:
 505     .return (res)
 506 .end
 507
 508
 509 =item C<os.tmpname ()>
 510
 511 Returns a string with a file name that can be used for a temporary file.
 512 The file must be explicitly opened before its use and explicitly removed
 513 when no longer needed.
 514
 515 =cut
 516
 517 .sub 'tmpname' :anon
 518     .param pmc extra :slurpy
 519     .local pmc res
 520     new $P0, 'Lua'
 521     $S0 = $P0.'tmpname'()
 522     new res, 'LuaString'
 523     set res, $S0
 524     .return (res)
 525 .end
 526
 527 =back
 528
 529 =head1 AUTHORS
 530
 531 Francois Perrad.
 532
 533 =cut
 534
 535
 536 # Local Variables:
 537 #   mode: pir
 538 #   fill-column: 100
 539 # End:
 540 # vim: expandtab shiftwidth=4 ft=pir: