src/ops/io.ops

   1 /*
   2  * $Id$
   3 ** io.ops
   4 */
   5
   6 VERSION = PARROT_VERSION;
   7 #include "../io/io_private.h"
   8
   9
  10 =head1 NAME
  11
  12 io.ops
  13
  14 =cut
  15
  16 =head1 DESCRIPTION
  17
  18 Parrot's IO API
  19
  20 =cut
  21
  22 ###############################################################################
  23
  24 =head2 Parrot IO API Operations
  25
  26
  27 =over 4
  28
  29 =cut
  30
  31
  32 ########################################
  33
  34 =item B<close>(invar PMC)
  35
  36 Close IO object $1
  37
  38 =cut
  39
  40 inline op close(invar PMC) :base_io {
  41   PIO_close(interp, $1);
  42 }
  43
  44 ########################################
  45
  46 =item B<fdopen>(out PMC, in INT, in STR)
  47
  48 Create ParrotIO object in $1 as a copy of file descriptor $2.
  49
  50 RT#42373: integral file descriptors might not exist outside of the UNIX
  51      platform.  This op needs work.
  52
  53 =cut
  54
  55 inline op fdopen(out PMC, in INT, in STR) :filesys_open {
  56     /* These char * need to go away soon */
  57     char * const mode = string_to_cstring(interp, $3);
  58
  59     $1 = PIO_fdopen(interp, NULL, (PIOHANDLE)$2, mode);
  60     if (!$1)
  61         $1 = pmc_new(interp, enum_class_Undef);
  62
  63     /* RT#42374 all results from string_to_cstring() need freeing
  64      but this generates ugly warnings WRT discarding the const
  65      qualifier -lt
  66     */
  67
  68     string_cstring_free(mode);
  69 }
  70
  71 =item B<getstdin>(out PMC)
  72
  73 Create a new ParrotIO object for the stdin file descriptor and
  74 store it in $1
  75
  76 =item B<getstdout>(out PMC)
  77
  78 Create a new ParrotIO object for the stdout file descriptor and
  79 store it in $1
  80
  81 =item B<getstderr>(out PMC)
  82
  83 Create a new ParrotIO object for the stderr file descriptor and
  84 store it in $1
  85
  86 =cut
  87
  88 inline op getstdin(out PMC) :base_io {
  89   $1 = _PIO_STDIN(interp);
  90 }
  91
  92 inline op getstdout(out PMC) :base_io {
  93   $1 = _PIO_STDOUT(interp);
  94 }
  95
  96 inline op getstderr(out PMC) :base_io {
  97   $1 = _PIO_STDERR(interp);
  98 }
  99
 100 #########################################
 101
 102 =item B<pioctl>(out INT, invar PMC, in INT, in INT)
 103
 104 Perform an operation an an IO object. This is a general purpose
 105 hook for setting various flags, modes, etc.
 106 Examples: setting the record separator or setting the buffering
 107
 108 =cut
 109
 110 inline op pioctl(out INT, invar PMC, in INT, in INT) :advanced_io :deprecated {
 111   $1 = PIO_pioctl(interp, $2, $3, $4);
 112 }
 113
 114
 115 #########################################
 116
 117 =item B<open>(out PMC, in STR, in STR)
 118
 119 Open URL (file, address, database, in core image) named $2 with
 120 Perl style mode string in $3 and create an IO object in $1.
 121
 122 =item B<open>(out PMC, in STR)
 123
 124 Open URL (file, address, database, in core image) named $2 with
 125 read/write mode and create an IO object in $1.
 126
 127 =cut
 128
 129 inline op open(out PMC, in STR, in STR) :filesys_open {
 130     /* These char * need to go away soon */
 131     char * const path = string_to_cstring(interp, $2);
 132     char * const mode = string_to_cstring(interp, $3);
 133
 134     $1 = PIO_open(interp, NULL, path, mode);
 135
 136     string_cstring_free(mode);
 137     string_cstring_free(path);
 138
 139     if (!$1 || !PMC_struct_val($1))
 140         $1 = pmc_new(interp, enum_class_Undef);
 141 }
 142
 143 inline op open(out PMC, in STR) :filesys_open {
 144     /* These char * need to go away soon */
 145     char * const path = string_to_cstring(interp, $2);
 146
 147     $1 = PIO_open(interp, NULL, path, "+<");
 148     string_cstring_free(path);
 149     if (!$1)
 150         $1 = pmc_new(interp, enum_class_Undef);
 151 }
 152
 153 ########################################
 154
 155 =item B<print>(in INT)
 156
 157 =item B<print>(in NUM)
 158
 159 =item B<print>(invar PMC)
 160
 161 =item B<print>(in STR)
 162
 163 Print $1 to standard output.
 164
 165 =cut
 166
 167 inline op print(in INT) :base_io {
 168   PIO_printf(interp, INTVAL_FMT, (INTVAL)$1);
 169 }
 170
 171 inline op print(in NUM) :base_io {
 172   PIO_printf(interp, FLOATVAL_FMT, $1);
 173 }
 174
 175 op print(in STR) :base_io {
 176   STRING * const s = $1;
 177   if (s && string_length(interp, s))
 178     PIO_putps(interp, _PIO_STDOUT(interp), s);
 179 }
 180
 181 op print(invar PMC) :base_io {
 182   PMC * const p = $1;
 183   STRING * const s = (VTABLE_get_string(interp, p));
 184   if (s)
 185     PIO_putps(interp, _PIO_STDOUT(interp), s);
 186 }
 187
 188 =item B<say>(in INT)
 189
 190 =item B<say>(in NUM)
 191
 192 =item B<say>(invar PMC)
 193
 194 =item B<say>(in STR)
 195
 196 Print $1 to standard output with a trailing newline.
 197
 198 =cut
 199
 200 inline op say(in INT) :base_io {
 201   PIO_printf(interp, INTVAL_FMT "\n", (INTVAL)$1);
 202 }
 203
 204 inline op say(in NUM) :base_io {
 205   PIO_printf(interp, FLOATVAL_FMT "\n", $1);
 206 }
 207
 208 op say(in STR) :base_io {
 209   STRING * const s = $1;
 210   if (s && string_length(interp, s))
 211     PIO_putps(interp, _PIO_STDOUT(interp), s);
 212   PIO_puts(interp, _PIO_STDOUT(interp), "\n");
 213 }
 214
 215 op say(invar PMC) :base_io {
 216   PMC * const p = $1;
 217   STRING * const s = (VTABLE_get_string(interp, p));
 218   if (s)
 219     PIO_putps(interp, _PIO_STDOUT(interp), s);
 220   PIO_puts(interp, _PIO_STDOUT(interp), "\n");
 221 }
 222
 223
 224
 225
 226 ##########################################
 227
 228 =item B<printerr>(in INT)
 229
 230 =item B<printerr>(in NUM)
 231
 232 =item B<printerr>(in STR)
 233
 234 =item B<printerr>(invar PMC)
 235
 236 Print $1 to standard error.
 237
 238 =cut
 239
 240 op printerr(in INT) :base_io {
 241   PIO_eprintf(interp, INTVAL_FMT, $1);
 242 }
 243
 244 op printerr(in NUM) :base_io {
 245   PIO_eprintf(interp, FLOATVAL_FMT, $1);
 246 }
 247
 248 op printerr(in STR) :base_io {
 249   STRING * const s = $1;
 250   if (s && string_length(interp, s))
 251     PIO_putps(interp, _PIO_STDERR(interp), s);
 252 }
 253
 254 op printerr(invar PMC) :base_io {
 255   PMC * const p = $1;
 256   STRING * const s = (VTABLE_get_string(interp, p));
 257   if (s)
 258     PIO_putps(interp, _PIO_STDERR(interp), s);
 259 }
 260
 261 ##########################################
 262
 263 =item B<print>(invar PMC, in INT)
 264
 265 =item B<print>(invar PMC, in NUM)
 266
 267 =item B<print>(invar PMC, in STR)
 268
 269 =item B<print>(invar PMC, invar PMC)
 270
 271 Print $2 on the IO stream object $1.
 272
 273 =cut
 274
 275 op print(invar PMC, in INT) :base_io {
 276   if ($1) {
 277     STRING * const s = Parrot_sprintf_c(interp, INTVAL_FMT, $2);
 278     PIO_putps(interp, $1, s);
 279   }
 280 }
 281
 282 op print(invar PMC, in NUM) :base_io {
 283   if ($1) {
 284     STRING * const s = Parrot_sprintf_c(interp, FLOATVAL_FMT, $2);
 285     PIO_putps(interp, $1, s);
 286   }
 287 }
 288
 289 op print(invar PMC, in STR) :base_io {
 290   if ($2 && $1) {
 291     PIO_putps(interp, $1, $2);
 292   }
 293 }
 294
 295 op print(invar PMC, invar PMC) :base_io {
 296   if ($2 && $1) {
 297     STRING * const s = VTABLE_get_string(interp, $2);
 298     PIO_putps(interp, $1, s);
 299   }
 300 }
 301
 302 ##########################################
 303
 304 =item B<read>(out STR, in INT)
 305
 306 Read up to N bytes from standard input stream
 307
 308 =item B<read>(out STR, invar PMC, in INT)
 309
 310 Read up to N bytes from IO PMC stream.
 311
 312 =cut
 313
 314 op read(out STR, in INT) :base_io {
 315   $1 = PIO_reads(interp, _PIO_STDIN(interp), (size_t)$2);
 316 }
 317
 318 op read(out STR, invar PMC, in INT) :base_io {
 319   $1 = PIO_reads(interp, $2, (size_t)$3);
 320 }
 321
 322 =item B<readline>(out STR, invar PMC)
 323
 324 Read a line up to EOL from filehandle $2.
 325 This switches the filehandle to linebuffer-mode.
 326
 327 =cut
 328
 329 inline op readline(out STR, invar PMC) :base_io {
 330     PMC * const pio = $2;
 331     ParrotIO *io;
 332     /* this ugly error handling will go away, when all the
 333      * io stuff are methods
 334      */
 335     if (pio->vtable->base_type != enum_class_ParrotIO)
 336         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
 337                 "Cannot read line from empty filehandle");
 338     io = (ParrotIO *)PMC_data(pio);
 339     if (!io)
 340         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
 341                 "Cannot read line from empty filehandle");
 342
 343     if (!(io->flags & PIO_F_LINEBUF))
 344         PIO_setlinebuf(interp, pio);
 345     $1 = PIO_reads(interp, pio, 0);
 346 }
 347
 348 ##########################################
 349
 350 =item B<peek>(out STR)
 351
 352 Returns the next byte from standard input, but does not
 353 remove it from the stream.
 354
 355 =item B<peek>(out STR, invar PMC)
 356
 357 Reads the next byte from an IO PMC, but does not
 358 remove it from the stream.
 359
 360 =cut
 361
 362 op peek(out STR) :base_io {
 363   STRING ** const s = &$1;
 364
 365   *s = NULL;
 366   PIO_peek(interp, _PIO_STDIN(interp), s);
 367 }
 368
 369 op peek(out STR, invar PMC) :base_io {
 370   STRING ** const s = &$1;
 371
 372   *s = NULL;
 373   PIO_peek(interp, $2, s);
 374 }
 375
 376 ##########################################
 377
 378 =item B<stat>(out INT, in STR, in INT)
 379
 380 =item B<stat>(out INT, in INT, in INT)
 381
 382 Stat the file. Return stat element $3 for file $2 into $1. The queryable
 383 items currently are:
 384
 385  EXISTS     0
 386  FILESIZE   1
 387  ISDIR      2
 388  ISDEV      3
 389  CREATETIME 4 (Time file was created)
 390  ACCESSTIME 5 (Time file was last accessed)
 391  MODIFYTIME 6 (Time file data was changed)
 392  CHANGETIME 7 (Time file metadata was changed)
 393  BACKUPTIME 8 (Time of last backup)
 394  UID        9
 395  GID        10
 396
 397
 398 =cut
 399
 400 op stat(out INT, in STR, in INT) {
 401   $1 = Parrot_stat_info_intval(interp, $2, $3);
 402 }
 403
 404 op stat(out INT, in INT, in INT) {
 405   $1 = Parrot_fstat_info_intval(interp, $2, $3);
 406 }
 407
 408
 409 ##########################################
 410
 411 =item B<seek>(invar PMC, in INT, in INT)
 412
 413 seek:
 414 Set file position to offset $2 on IO stream $1. 'whence' is
 415 indicated by the value in $3.
 416
 417 =item B<seek>(invar PMC, in INT, in INT, in INT)
 418
 419 64bit seek:
 420 Set file position to offset ($2 << 32 | $3) on IO stream $1. 'whence' is
 421 indicated by the value in $4. This allows 64-bit seeks with only 32-bit
 422 INTVALS.
 423
 424 =cut
 425
 426 op seek(invar PMC, in INT, in INT) :base_io {
 427   if ($1) {
 428     if (PIO_seek(interp, $1, PIO_make_offset($2), $3) < 0)
 429       Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
 430             "seek failed (32bit)");
 431   }
 432 }
 433
 434 op seek(invar PMC, in INT, in INT, in INT) :base_io {
 435   if ($1) {
 436     if (PIO_seek(interp, $1, PIO_make_offset32($2, $3), $4) < 0)
 437       Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
 438             "seek failed (64bit)");
 439   }
 440 }
 441
 442 =item B<tell>(out INT, invar PMC)
 443
 444 tell:
 445 Get the current file position of stream $2 and store it in $1.
 446 On systems where INTVAL is 32bit the result will be truncated if the
 447 position is beyond 2 GiB
 448
 449 =item B<tell>(out INT, out INT, invar PMC)
 450
 451 64bit tell:
 452 Get the current file positon of stream $3 in two parts of 32-bit each
 453 ($1 = pos >> 32, $2 = pos & 0xffffffff).
 454
 455 =cut
 456
 457 op tell(out INT, invar PMC) :base_io {
 458   if ($2)
 459     $1 = (INTVAL)PIO_tell(interp, $2);
 460 }
 461
 462 op tell(out INT, out INT, invar PMC) :base_io {
 463   if ($3) {
 464     PIOOFF_T pos;
 465     pos = PIO_tell(interp, $3);
 466     $1 = (INTVAL)(pos >> 31);
 467     $2 = (INTVAL)(pos & 0xffffffff);
 468   }
 469 }
 470
 471 ########################################
 472
 473 =item B<socket>(out PMC, in INT, in INT, in INT)
 474
 475 =item B<sockaddr>(out STR, in INT, in STR)
 476
 477 =item B<connect>(out INT, invar PMC, in STR)
 478
 479 =item B<recv>(out INT, invar PMC, out STR)
 480
 481 =item B<send>(out INT, invar PMC, in STR)
 482
 483 =item B<poll>(out INT, invar PMC, in INT, in INT, in INT)
 484
 485 =item B<bind>(out INT, invar PMC, in STR)
 486
 487 =item B<listen>(out INT, invar PMC, in INT)
 488
 489 =item B<accept>(out PMC, invar PMC)
 490
 491 =cut
 492
 493 op socket(out PMC, in INT, in INT, in INT) :base_network {
 494   $1 = PIO_socket(interp, $2, $3, $4);
 495   if (!$1)
 496     $1 = pmc_new(interp, enum_class_Undef);
 497 }
 498
 499 op sockaddr(out STR, in INT, in STR) :base_network {
 500     $1 = PIO_sockaddr_in(interp, (unsigned short)$2, $3);
 501 }
 502
 503 op connect(out INT, invar PMC, in STR) :base_network {
 504     $1 = (INTVAL)PIO_connect(interp, $2, $3);
 505 }
 506
 507 op recv(out INT, invar PMC, out STR) :base_network {
 508     STRING *dest = $3;
 509     $1 = (INTVAL)PIO_recv(interp, $2, &dest);
 510     $3 = dest;
 511 }
 512
 513 op send(out INT, invar PMC, in STR) :base_network {
 514     $1 = (INTVAL)PIO_send(interp, $2, $3);
 515 }
 516
 517 op poll(out INT, invar PMC, in INT, in INT, in INT) :base_network {
 518     $1 = (INTVAL)PIO_poll(interp, $2, $3, $4, $5);
 519 }
 520
 521 op bind(out INT, invar PMC, in STR) :base_network {
 522     $1 = (INTVAL)PIO_bind(interp, $2, $3);
 523 }
 524
 525 op listen(out INT, invar PMC, in INT) :base_network {
 526     $1 = (INTVAL)PIO_listen(interp, $2, $3);
 527 }
 528
 529 op accept(out PMC, invar PMC) :base_network {
 530     $1 = PIO_accept(interp, $2);
 531 }
 532
 533 ########################################
 534
 535 =back
 536
 537 =cut
 538
 539
 540 ###############################################################################
 541
 542 =head1 COPYRIGHT
 543
 544 Copyright (C) 2001-2008, The Perl Foundation.
 545
 546 =head1 LICENSE
 547
 548 This program is free software. It is subject to the same license
 549 as the Parrot interpreter itself.
 550
 551 =cut
 552
 553
 554 /*
 555  * Local variables:
 556  *   c-file-style: "parrot"
 557  * End:
 558  * vim: expandtab shiftwidth=4:
 559  */