view release on metacpan or  search on metacpan

GDiffDelta.xs  view on Meta::CPAN

 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <errno.h>

#undef assert
#include <assert.h>

#define QEF_BUFSZ 8192

#if 0
#define QEF_DEBUG_IO
#endif


#include "util.c"


static void
careful_fread (void *ptr, size_t size, SV *f, const char *from)
{
#ifdef QEF_DEBUG_IO
    fprintf(stderr, "read from %p (%s): %u bytes ->%p\n", (void *) f, from,
            (unsigned int) size, ptr);
#endif

    if (sv_isobject(f)) {
        I32 n;
        SV *ret, *buf;
        STRLEN len;
        char *str;

        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(f);
        /* TODO - possibly use newSVpvn_share to avoid the memcpy
         * and extra allocation for buf? */
        XPUSHs(sv_2mortal(buf = newSVpvn("", 0)));
        XPUSHs(sv_2mortal(newSVuv(size)));
        PUTBACK;
        n = call_method("read", G_SCALAR);
        assert(n == 0 || n == 1);
        SPAGAIN;
        ret = n ? POPs : &PL_sv_undef;
        if (!SvOK(ret))
            croak("error reading from %s: %s", from,
                  SvPV_nolen(get_sv("!", FALSE)));
        if (SvUV(ret) != size)
            croak("%s ends unexpectedly", from);
        if (!SvPOK(buf) || SvCUR(buf) != size)
            croak("'read' method left buffer badly set up", from);
        str = SvPV(buf, len);
        assert(len == size);
        memcpy(ptr, str, size);
        PUTBACK;
        FREETMPS;
        LEAVE;
    }
    else {
        int r = PerlIO_read(IoIFP(sv_2io(f)), ptr, size);
        if (r < 0)
            croak("error reading from %s: %s", from, strerror(errno));
        else if ((size_t) r != size)
            croak("%s ends unexpectedly", from);
    }
}

static void
careful_fwrite (const void *ptr, size_t size, SV *f, const char *to)
{
    I32 n;
    SV *ret;

#ifdef QEF_DEBUG_IO
    fprintf(stderr, "write to %p (%s): %u bytes <-%p\n", (void *) f, to,
            (unsigned int) size, ptr);
#endif

    if (sv_isobject(f)) {
        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(f);
        XPUSHs(sv_2mortal(newSVpvn(ptr, size)));
        XPUSHs(sv_2mortal(newSVuv(size)));
        PUTBACK;
        n = call_method("write", G_SCALAR);
        assert(n == 0 || n == 1);
        SPAGAIN;
        ret = n ? POPs : &PL_sv_no;
        n = SvTRUE(ret);
        PUTBACK;
        FREETMPS;
        LEAVE;
        if (!n)
            croak("error writing to %s: %s", to,
                  SvPV_nolen(get_sv("!", FALSE)));
    }
    else {
        if ((size_t) PerlIO_write(IoIFP(sv_2io(f)), ptr, size) != size)
            croak("error writing to %s: %s", to, strerror(errno));
    }
}

static void
careful_fseek_whence (SV *f, Off_t offset, const char *from, int whence)
{
    assert(whence == SEEK_SET || whence == SEEK_CUR || whence == SEEK_END);
#ifdef QEF_DEBUG_IO
    fprintf(stderr, "seek %p (%s): %s %u\n", (void *) f, from,
            (whence == SEEK_SET ? "SEEK_SET" :
             whence == SEEK_CUR ? "SEEK_CUR" : "SEEK_END"),
            (unsigned int) offset);
#endif

    if (sv_isobject(f)) {
        I32 n;
        SV *ret;

        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(f);
        XPUSHs(sv_2mortal(newSVuv(offset)));
        XPUSHs(sv_2mortal(newSVuv(whence)));
        PUTBACK;
        n = call_method("seek", G_SCALAR);
        assert(n == 0 || n == 1);
        SPAGAIN;
        ret = n ? POPs : &PL_sv_undef;
        n = SvTRUE(ret);
        PUTBACK;
        FREETMPS;
        LEAVE;
        if (!n)
            croak("error seeking in %s: %s", from,
                  SvPV_nolen(get_sv("!", FALSE)));
    }
    else {
        if (PerlIO_seek(IoIFP(sv_2io(f)), offset, whence))
            croak("error seeking in %s: %s", from, strerror(errno));
    }
}

QEF_INLINE static void
careful_fseek (SV *f, Off_t offset, const char *from)
{
    careful_fseek_whence(f, offset, from, SEEK_SET);
}

static Off_t
careful_ftell (SV *f, const char *from)
{
    Off_t offset;

    if (sv_isobject(f)) {
        I32 n;
        SV *ret;

        dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(f);
        PUTBACK;
        n = call_method("tell", G_SCALAR);
        assert(n == 0 || n == 1);
        SPAGAIN;
        offset = (Off_t) -1;
        if (n) {
            ret = POPs;
            if (SvOK(ret))
                offset = SvUV(ret);
        }
        PUTBACK;
        FREETMPS;
        LEAVE;
        if (offset == (Off_t) -1)
            croak("error getting position in %s: %s", from,
                  SvPV_nolen(get_sv("!", FALSE)));
    }
    else {
        offset = PerlIO_tell(IoIFP(sv_2io(f)));
        if (offset == (Off_t) -1)
            croak("error getting position in %s: %s", from, strerror(errno));
    }

    return offset;
}

QEF_INLINE static size_t
read_ubyte (SV *f)
{
    unsigned char buf;
    careful_fread(&buf, 1, f, "delta");
    return buf;
}

QEF_INLINE static size_t
read_ushort (SV *f)
{
    unsigned char buf[2];
    careful_fread(buf, 2, f, "delta");
    return buf[0] * 0x100 + buf[1];
}

QEF_INLINE static size_t
read_int (SV *f)
{
    unsigned char buf[4];
    careful_fread(buf, 4, f, "delta");
    if (buf[0] >= 0x7F)
        croak("delta contains negative int value");
    return buf[0] * 0x1000000 + buf[1] * 0x10000 +
           buf[2] * 0x100 + buf[3];
}

/* The buffer is supplied by the parent so that we can avoid allocating
 * it on the stack every time this is called, even though that probably
 * wouldn't be very expensive in most implementations.  */
static void
copy_data (SV *in, SV *out, size_t num_bytes, unsigned char *buf,
           const char *from, const char *to)
{
    assert(buf);

    while (num_bytes >= QEF_BUFSZ) {
        careful_fread(buf, QEF_BUFSZ, in, from);
        careful_fwrite(buf, QEF_BUFSZ, out, to);
        num_bytes -= QEF_BUFSZ;
    }

    careful_fread(buf, num_bytes, in, from);
    careful_fwrite(buf, num_bytes, out, to);
}

/* Work out the size of the file by seeking to the end.  */
static Off_t
file_size (SV *f, const char *from)
{
    careful_fseek_whence(f, 0, from, SEEK_END);
    return careful_ftell(f, from);
}