/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id: parrotio.pmc 16587 2007-01-13 14:43:09Z pmichaud $

=head1 NAME

src/pmc/parrotio.pmc - Parrot IO

=head1 DESCRIPTION

These are the vtable functions for Parrot IO.

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"
#include <assert.h>

/* This class is actually part of the io subsystem */
#include "../src/io/io_private.h"

#ifdef PARROT_HAS_READLINE
extern char* readline(const char*);
void add_history(const char*);
#endif

pmclass ParrotIO need_ext {

/*

=item C<METHOD INTVAL say(STRING *s)>

Print the string with an appended newline to SELF or to stdout if used as a
class method.

=cut

*/

    METHOD INTVAL say(STRING *s) {
        PMC *out = SELF == interp->vtables[enum_class_ParrotIO]->class ?
            PIO_STDOUT(INTERP) : SELF;
        INTVAL r = PIO_putps(INTERP, out, s);
        r  += PIO_puts(INTERP, out, "\n");
        return r;
    }
/*

=item C<METHOD PMC* open(STRING* file, STRING *mode, STRING* layer)>

Opens the file with the given mode, using the given IO layer.

=cut

*/

    METHOD PMC* open(STRING* file, STRING *mode, STRING* layer) {
        ParrotIOLayer *l;
        const char *c_file, *c_mode, *c_layer;
        PMC *pio;

        c_file = string_to_cstring(INTERP, file);
        c_mode = string_to_cstring(INTERP, mode);
        c_layer = string_to_cstring(INTERP, layer);
        l = PIO_get_layer(INTERP, c_layer);
        pio = PIO_open(INTERP, l, c_file, c_mode);
        if (!pio || !PMC_struct_val(pio))
            return pmc_new(INTERP, enum_class_Undef);
        if (l) {
            ParrotIO *io = PMC_data(pio);
            int is_mmap = strcmp(c_layer, "mmap") == 0;
            /*
             * XXX move this into the layer
             */
            if ((is_mmap && (io->b.flags & PIO_BF_MMAP)) || !is_mmap) {
                l = interp->piodata->default_stack;
                if (!strcmp(l->name, "buf"))
                    l = l->down;
                /* XXX layer is stored twice - which is used when */
                io->stack = PMC_struct_val(pio) = l;
                /* push the layer */
                PIO_push_layer_str(INTERP, pio, layer);
            }
            else {
                l = interp->piodata->default_stack;
                io->stack = PMC_struct_val(pio) = l;
            }
        }
        /* XXX leaks as in ops/io.ops: open */
        return pio;
    }

/*

=item C<METHOD INTVAL set_readline_interactive(INTVAL)>

Sets readline interactive mode to the given value, if PARROT_HAS_READLINE is
defined, that is, if the readline library is available.  The return values are:

=over

=item * -1

readline isn't configured

=item * -2

The file is not open/not input or not a tty, if turning on interactive.

=item * 0 / 1

old interactive setting

=back

=item C<METHOD PMC* readline(STRING* prompt)>

Reads a line from the given PIO. If readline is interactive and a prompt
is not empty, it will be displayed. The interactive feature is not
available with the C<readline> opcode (which will be removed anyway).
Interactive mode adds non-empty lines to the readline history.

Returns the line without the newline in a String PMC. If ^D/eof occurred,
this will return a Null PMC.

SYNOPSIS

      pio = getstdin
      $I0 = pio.'set_readline_interactive'(1)
      if $I0 >= 0 goto loop
      printerr "set_readline_interactive failed: "
      ...
  loop:
      $P1 = pio.'readline'('hello polly> ')
      if null $P1  goto ex
      ..
      goto loop
  ex:

=cut

*/

    METHOD INTVAL set_readline_interactive(INTVAL on) {
        ParrotIO *io = PMC_data(SELF);
#ifdef PARROT_HAS_READLINE
        INTVAL flag;
#endif
        if (!io)
            return -2;
        if (!(io->flags & PIO_F_READ))
            return -2;
#ifdef PARROT_HAS_READLINE
        if (on && !(io->flags & PIO_F_CONSOLE))
            return -2;
        flag = !!(io->flags & PIO_F_READLINE);
        if (on)
            io->flags |= PIO_F_READLINE;
        else
            io->flags &= ~PIO_F_READLINE;
        return flag;
#else
        return -1;
#endif
    }

    METHOD PMC* readline(STRING* prompt) {
        ParrotIO *io = PMC_data(SELF);
        PMC *pmc_res = NULL;
        STRING *res = NULL;
        UINTVAL len;

        if (!io)
            return NULL;
#ifdef PARROT_HAS_READLINE
        if (io->flags & PIO_F_READLINE) {
            char *r;

            r = readline(prompt ? prompt->strstart : NULL);
            if (r) {
                if (*r)
                    add_history(r);
                res = string_from_cstring(INTERP, r, 0);
                free(r);
                pmc_res = pmc_new(INTERP, enum_class_String);
                PMC_str_val(pmc_res) = res;
                return pmc_res;
            }
            return PMCNULL;
        }
        else
#endif
        {
            if (!(io->flags & PIO_F_LINEBUF))
                PIO_setlinebuf(interp, SELF);
            res = PIO_reads(interp, SELF, 0);
            if (!res)
                return PMCNULL;
            /* readline should better return the string w/o NL */
            len = string_length(INTERP, res);
            while (len && (((char*)res->strstart)[len-1] == '\n'
                       ||  ((char*)res->strstart)[len-1] == '\r')) {
                --len;
                --res->strlen;
                --res->bufused;
            }
            pmc_res = pmc_new(INTERP, enum_class_String);
            PMC_str_val(pmc_res) = res;
            return pmc_res;
        }
    }

/*

=item METHOD STRING* slurp(STRING* name);

Slurp an (existing, disc) file named I<name> into a STRING result.

Please note that this method isn't catching any failures yet.

Usage as class method:

  .local pmc cl
  cl = getclass 'ParrotIO'
  $S0 = cl.'slurp'('the_file')

The file will be opened, read, and closed.

Or with an openend file:

  pio = open 'the_file', '<'
  $S0 = pio.'slurp'('')

This does B<not> close the file.

=cut

*/

    METHOD STRING* slurp(STRING* name) {
        STRING* result;
        if (!PMC_data0(SELF)) {
            /* called as class method - open, slurp, close file */
            char * const path = string_to_cstring(interp, name);
            INTVAL size = Parrot_stat_info_intval(INTERP, name, STAT_FILESIZE);
            PMC* pio = PIO_open(INTERP, NULL, path, "<");
            string_cstring_free(path);
            /* TODO handle stdin */
            result = PIO_reads(INTERP, pio, size);
            PIO_close(INTERP, pio);
            return result;
        }
        else {
            /* slurp open file */
            STRING *part;
            if (!PMC_data(SELF))
                real_exception(interp, NULL, PIO_ERROR,
                        "Cannot slurp from empty filehandle");
            result = NULL;
            do {
                part = PIO_reads(INTERP, SELF, 4096);
                if (string_length(INTERP, part) == 0)
                    break;
                result = string_append(INTERP, result, part);
            } while (1);
        }
        return result;
    }

/*

=item C<void class_init()>

Class initialization.

=item C<METHOD INTVAL eof()>

Returns true or false according to the end of file state of the object.

=item C<METHOD void flush()>

Flushes pending writes.

=item C<METHOD INTVAL setbuf(INTVAL)>

XXX TBD

=item C<METHOD INTVAL setlinebuf()>

XXX TBD

=cut

*/

    void class_init() {

        if (pass) {
            enter_nci_method(INTERP, enum_class_ParrotIO,
                    F2DPTR(PIO_flush), "flush", "vJO");
            enter_nci_method(INTERP, enum_class_ParrotIO,
                    F2DPTR(PIO_setbuf), "setbuf", "iJOi");
            enter_nci_method(INTERP, enum_class_ParrotIO,
                    F2DPTR(PIO_setlinebuf), "setlinebuf", "iJO");
            enter_nci_method(INTERP, enum_class_ParrotIO,
                    F2DPTR(PIO_puts), "puts", "iJOt");
            enter_nci_method(INTERP, enum_class_ParrotIO,
                    F2DPTR(PIO_eof), "eof", "iJO");
        }
    }

/*

=item C<void init()>

Initializes the IO PMC.

=cut

*/

    void init() {
        PObj_active_destroy_SET(SELF);
    }

/*

=item C<void destroy()>

Destroys the IO PMC, flushing and closing as necessary.

=cut

*/

    void destroy() {
        ParrotIO *io = PMC_data(SELF);
        if (io) {
            /* shared filehandles will only get flushed */
            if (io->flags & PIO_F_SHARED) {
                PIO_flush(INTERP, SELF);
            }
            else {
                PIO_close(INTERP, SELF);
            }
        }
    }

/*

=item C<PMC* clone()>

Clones the IO PMC.

For now, both PMCs refer to the same C<ParrotIO> object. If we have different
IO layers, we might copy C<data> and C<struct_val>.

=cut

*/

    PMC* clone() {
        PMC* dest = pmc_new(INTERP, SELF->vtable->base_type);
        PMC_data(dest) = PMC_data(SELF);
        PMC_struct_val(dest) = PMC_struct_val(SELF);
        return dest;
    }

/*

=item C<INTVAL get_bool()>

Returns whether at C<EOF> or not.

=cut

*/

    INTVAL get_bool() {
        return !PIO_eof(INTERP, SELF);
    }

/*

=item C<STRING* get_string_keyed_int(INTVAL n)>

Returns the name of the nth layer. B<n> >= 0 returns layer names up from the
bottom.  If B<n> is negative, returns layer names from top down. For
non-existent layers, returns an empty string.

=cut

*/

    STRING* get_string_keyed_int(INTVAL n) {
        ParrotIO *io = PMC_data(SELF);
        ParrotIOLayer *layer;
        if (!io)
            return const_string(INTERP, "");
        layer = io->stack;
        if (n >= 0) {
            ParrotIOLayer *last;
            last = layer;
            for (; layer; layer = layer->down)
                last = layer;
            for (; n && last; --n, last = last->up)
                ;
            if (last)
                return string_from_cstring(INTERP, last->name, 0);
            return const_string(INTERP, "");
        }
        for (++n; n && layer; layer = layer->down, ++n)
            ;
        if (layer)
            return string_from_cstring(INTERP, layer->name, 0);
        return const_string(INTERP, "");
    }
/*

=item C<void push_string(STRING* value)>

Pushes the layer name C<value> onto the PIO's layer stack.

=item C<STRING* pop_string()>

Pops a layer off the PIO's layer stack and returns its name.

=cut

*/

    void push_string(STRING* value) {
        PIO_push_layer_str(INTERP, SELF, value);
    }

    STRING* pop_string() {
        return PIO_pop_layer_str(INTERP, SELF);
    }

}

/*

=back

=head1 HISTORY

Initial version by leo 2003/06/23.

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */
