view release on metacpan or  search on metacpan

LibMagic.xs  view on Meta::CPAN

    OUTPUT:
        RETVAL

IV magic_version()
    CODE:
#ifdef HAVE_MAGIC_VERSION
        RETVAL = magic_version();
#else
        RETVAL = 0;
#endif
    OUTPUT:
        RETVAL

#define MAGIC_SETFLAGS_OR_CROAK(magic, flags) \
        if ( magic_setflags(magic, flags) == -1 ) {       \
            croak( "error setting flags to %d", flags );  \
        }                                                 \

#define MAYBE_CROAK_ERROR(retval, magic, magic_func) \
        if ( NULL == retval ) {                   \
            const char *err = magic_error(magic); \
            croak("error calling %s: %s", #magic_func, err != NULL ? err : "magic_error() returned NULL"); \
        }

#define RETURN_INFO(self, magic_func, ...) \
        magic = (magic_t)SvIV(*( hv_fetchs((HV *)SvRV(self), "magic", 0))); \
        flags = (int)SvIV(*( hv_fetchs((HV *)SvRV(self), "flags", 0))); \
        MAGIC_SETFLAGS_OR_CROAK(magic, flags)                     \
        description = magic_func(magic, __VA_ARGS__);             \
        MAYBE_CROAK_ERROR(description, magic, magic_func)         \
        d = newSVpvn(description, strlen(description));           \
        MAGIC_SETFLAGS_OR_CROAK(magic, flags|MAGIC_MIME_TYPE)     \
        magic_setflags(magic, flags|MAGIC_MIME_TYPE);             \
        mime = magic_func(magic, __VA_ARGS__);                    \
        MAYBE_CROAK_ERROR(mime, magic, magic_func)                \
        m = newSVpvn(mime, strlen(mime));                         \
        MAGIC_SETFLAGS_OR_CROAK(magic, flags|MAGIC_MIME_ENCODING) \
        encoding = magic_func(magic, __VA_ARGS__);                \
        MAYBE_CROAK_ERROR(encoding, magic, magic_func)            \
        e = newSVpvn(encoding, strlen(encoding));                 \
        EXTEND(SP, 3);                                            \
        mPUSHs(d);                                                \
        mPUSHs(m);                                               \
        mPUSHs(e);

void _info_from_string(self, buffer)
        SV *self
        SV *buffer
    PREINIT:
        magic_t magic;
        int flags;
        SV *content;
        STRLEN len;
        char *string;
        const char *description;
        const char *mime;
        const char *encoding;
        SV *d;
        SV *m;
        SV *e;
    PPCODE:
        if (SvROK(buffer)) {
            content = SvRV(buffer);
        }
        else {
            content = buffer;
        }

        if ( ! SvPOK(content) ) {
            croak("info_from_string requires a scalar or reference to a scalar as its argument");
        }

        string = SvPV(content, len);

        RETURN_INFO(self, magic_buffer, string, len);

void _info_from_filename(self, filename)
        SV *self
        SV *filename
    PREINIT:
        magic_t magic;
        int flags;
        char *file;
        const char *description;
        const char *mime;
        const char *encoding;
        SV *d;
        SV *m;
        SV *e;
    PPCODE:
        if ( ! SvPOK(filename) ) {
            croak("info_from_filename requires a scalar as its argument");
        }

        file = SvPV_nolen(filename);

        RETURN_INFO(self, magic_file, file);

void _info_from_handle(self, handle)
        SV *self
        SV *handle
    PREINIT:
        magic_t magic;
        int flags;
        PerlIO *io;
        char buf[BUFSIZE];
        Off_t pos;
        SSize_t read;
        const char *description;
        const char *mime;
        const char *encoding;
        SV *d;
        SV *m;
        SV *e;
    PPCODE:
        if ( ! SvOK(handle) ) {
            croak("info_from_handle requires a scalar filehandle as its argument");
        }

        io = IoIFP(sv_2io(handle));
        if ( ! io ) {
            croak("info_from_handle requires a scalar filehandle as its argument");
        }

        pos = PerlIO_tell(io);
        if ( pos < 0 ) {
            croak("info_from_handle could not call tell() on the filehandle provided: %s", strerror(errno));
        }

        read = PerlIO_read(io, buf, BUFSIZE);
        if ( read < 0 ) {
            croak("info_from_handle could not read data from the filehandle provided: %s", strerror(errno));
        }
        else if ( 0 == read ) {
            croak("info_from_handle could not read data from the filehandle provided - is the file empty?");
        }

        PerlIO_seek(io, pos, SEEK_SET);

        RETURN_INFO(self, magic_buffer, buf, read);