/* $Id$ Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@uva.nl WWW: http://www.swi-prolog.org Copyright (C): 1985-2009, University of Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #include #include #include #include #include #include #include "error.h" #define streq(s,q) (strcmp((s), (q)) == 0) /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Memory-files make_memory_file(-Handle) free_memory_file(+Handle) open_memory_file(+Handle, +Mode, -Stream) size_memory_file(+Handle, -Size) memory_file_to_codes(+Handle, -Codes) memory_file_to_atom(+Handle, -Atom) atom_to_memory_file(+Atom, -Handle) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static functor_t FUNCTOR_memory_file1; static atom_t ATOM_encoding; static atom_t ATOM_unknown; static atom_t ATOM_octet; static atom_t ATOM_ascii; static atom_t ATOM_iso_latin_1; static atom_t ATOM_text; static atom_t ATOM_utf8; static atom_t ATOM_unicode_be; static atom_t ATOM_unicode_le; static atom_t ATOM_wchar_t; static atom_t ATOM_read; static atom_t ATOM_write; static atom_t ATOM_free_on_close; #define MEMFILE_MAGIC 0x5624a6b3L #define NOSIZE ((size_t)-1) typedef struct { long magic; /* MEMFILE_MAGIC */ IOENC encoding; /* encoding of the data */ int free_on_close; /* free if it is closed */ char *data; /* data of the file */ size_t data_size; /* byte-size of data */ size_t size; /* size in characters */ IOSTREAM *stream; /* Stream hanging onto it */ atom_t atom; /* Created from atom */ } memfile; static int unify_memfile(term_t handle, memfile *f) { return PL_unify_term(handle, PL_FUNCTOR, FUNCTOR_memory_file1, PL_POINTER, f); } static int get_memfile(term_t handle, memfile **f) { if ( PL_is_functor(handle, FUNCTOR_memory_file1) ) { term_t a = PL_new_term_ref(); void *ptr; _PL_get_arg(1, handle, a); if ( PL_get_pointer(a, &ptr) ) { memfile *m = ptr; if ( m->magic == MEMFILE_MAGIC ) { *f = ptr; return TRUE; } return pl_error(NULL, 0, NULL, ERR_EXISTENCE, "memory_file", handle); } } return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1, handle, "memory_file"); } static foreign_t new_memory_file(term_t handle) { memfile *m = calloc(1, sizeof(*m)); if ( !m ) return pl_error(NULL, 0, NULL, ERR_ERRNO, errno, "create", "memory_file", handle); m->magic = MEMFILE_MAGIC; m->encoding = ENC_UTF8; m->data = 0; m->size = 0; if ( unify_memfile(handle, m) ) return TRUE; m->magic = 0; free(m); return FALSE; } static int destroy_memory_file(memfile *m) { if ( m->stream ) Sclose(m->stream); if ( m->atom ) PL_unregister_atom(m->atom); else if ( m->data ) Sfree(m->data); /* MS-Windows: malloc by other DLL! */ m->magic = 0; free(m); return TRUE; } static foreign_t free_memory_file(term_t handle) { memfile *m; if ( get_memfile(handle, &m) ) return destroy_memory_file(m); return FALSE; } static void closehook(void *closure) { memfile *m = closure; m->stream = NULL; if ( m->free_on_close ) destroy_memory_file(m); } static foreign_t alreadyOpen(term_t handle, const char *op) { return pl_error(NULL, 0, "already open", ERR_PERMISSION, handle, op, "memory_file"); } static struct encname { IOENC code; atom_t *name; } encoding_names[] = { { ENC_UNKNOWN, &ATOM_unknown }, { ENC_OCTET, &ATOM_octet }, { ENC_ASCII, &ATOM_ascii }, { ENC_ISO_LATIN_1, &ATOM_iso_latin_1 }, { ENC_ANSI, &ATOM_text }, { ENC_UTF8, &ATOM_utf8 }, { ENC_UNICODE_BE, &ATOM_unicode_be }, { ENC_UNICODE_LE, &ATOM_unicode_le }, { ENC_WCHAR, &ATOM_wchar_t }, { ENC_UNKNOWN, NULL }, }; IOENC atom_to_encoding(atom_t a) { struct encname *en; for(en=encoding_names; en->name; en++) { if ( *en->name == a ) return en->code; } return ENC_UNKNOWN; } static int get_encoding(term_t t, IOENC *enc) { atom_t en; if ( PL_get_atom(t, &en) ) { IOENC encoding; if ( (encoding = atom_to_encoding(en)) == ENC_UNKNOWN ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, t, "encoding"); *enc = encoding; return TRUE; } return pl_error(NULL, 0, NULL, ERR_TYPE, t, "encoding"); } static foreign_t open_memory_file4(term_t handle, term_t mode, term_t stream, term_t options) { memfile *m; char *x; atom_t iom; IOSTREAM *fd; IOENC encoding; int free_on_close = FALSE; if ( !get_memfile(handle, &m) ) return FALSE; if ( m->stream ) return alreadyOpen(handle, "open"); if ( !PL_get_atom(mode, &iom) ) return pl_error("open_memory_file", 3, NULL, ERR_ARGTYPE, 2, mode, "io_mode"); encoding = m->encoding; if ( options ) { term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); while(PL_get_list(tail, head, tail)) { int arity; atom_t name; if ( PL_get_name_arity(head, &name, &arity) && arity == 1 ) { term_t arg = PL_new_term_ref(); _PL_get_arg(1, head, arg); if ( name == ATOM_encoding ) { if ( !get_encoding(arg, &encoding) ) return FALSE; } else if ( name == ATOM_free_on_close ) { if ( !PL_get_bool(arg, &free_on_close) ) return pl_error("open_memory_file", 4, NULL, ERR_TYPE, arg, "boolean"); } } else return pl_error("open_memory_file", 4, NULL, ERR_TYPE, head, "option"); } if ( !PL_get_nil(tail) ) return pl_error("open_memory_file", 4, NULL, ERR_TYPE, tail, "list"); } if ( iom == ATOM_write ) { x = "w"; if ( m->atom ) return pl_error("open_memory_file", 3, NULL, ERR_PERMISSION, handle, "write", "memory_file"); if ( m->data ) { Sfree(m->data); m->data = NULL; } m->data_size = 0; m->size = NOSIZE; /* don't know */ m->encoding = encoding; } else if ( iom == ATOM_read ) { x = "r"; m->free_on_close = free_on_close; } else { return pl_error("open_memory_file", 3, NULL, ERR_DOMAIN, mode, "io_mode"); } if ( !(fd = Sopenmem(&m->data, &m->data_size, x)) ) return pl_error("open_memory_file", 3, NULL, ERR_ERRNO, errno, "create", "memory_file", handle); fd->close_hook = closehook; fd->closure = m; fd->encoding = encoding; m->stream = fd; return PL_unify_stream(stream, fd); } static foreign_t open_memory_file(term_t handle, term_t mode, term_t stream) { return open_memory_file4(handle, mode, stream, 0); } static foreign_t size_memory_file(term_t handle, term_t size) { memfile *m; if ( get_memfile(handle, &m) ) { if ( m->stream && !m->atom ) return alreadyOpen(handle, "size"); if ( m->data ) { if ( m->size == NOSIZE ) { switch( m->encoding ) { case ENC_ISO_LATIN_1: case ENC_OCTET: m->size = m->data_size; break; case ENC_WCHAR: m->size = m->data_size / sizeof(wchar_t); break; case ENC_UTF8: m->size = PL_utf8_strlen(m->data, m->data_size); break; default: assert(0); return FALSE; } } return PL_unify_integer(size, m->size); } else return PL_unify_integer(size, 0); } return FALSE; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - utf8_position_memory_file(+MF, -Here, -Size) Given MF is a UTF-8 encoded memory file, unify here with the byte-position of the read-pointer and Size with the total size of the memory file in bytes. This is a bit hacky predicate, but the information is easily available at low cost, while it is very valuable for producing answers in content-length computation of the HTTP server. See http_wrapper.pl - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static foreign_t utf8_position(term_t handle, term_t here, term_t size) { memfile *m; if ( !get_memfile(handle, &m) ) return FALSE; if ( m->encoding != ENC_UTF8 ) return pl_error(NULL, 0, "no UTF-8 encoding", ERR_PERMISSION, handle, "utf8_position", "memory_file"); if ( !PL_unify_integer(size, m->data_size) ) return FALSE; if ( m->stream ) { IOPOS *op = m->stream->position; long p; m->stream->position = NULL; p = Stell(m->stream); m->stream->position = op; return PL_unify_integer(here, p); } else return PL_unify_integer(here, 0); } static foreign_t atom_to_memory_file(term_t atom, term_t handle) { atom_t a; if ( PL_get_atom(atom, &a) ) { memfile *m = calloc(1, sizeof(*m)); if ( !m ) return pl_error(NULL, 0, NULL, ERR_ERRNO, errno, "create", "memory_file", handle); m->atom = a; PL_register_atom(m->atom); m->magic = MEMFILE_MAGIC; if ( (m->data = (char *)PL_atom_nchars(a, &m->size)) ) { m->encoding = ENC_ISO_LATIN_1; m->data_size = m->size; } else if ( (m->data = (char *)PL_atom_wchars(a, &m->size)) ) { m->encoding = ENC_WCHAR; m->data_size = m->size * sizeof(wchar_t); } else if ( PL_blob_data(a, &m->size, NULL) ) { m->data = PL_blob_data(a, &m->data_size, NULL); m->encoding = ENC_OCTET; m->size = m->data_size; } if ( unify_memfile(handle, m) ) return TRUE; else { PL_unregister_atom(m->atom); m->magic = 0; free(m); return FALSE; } } else { return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1, atom, "atom"); } } static foreign_t memory_file_to_text(term_t handle, term_t atom, term_t encoding, int flags) { memfile *m; if ( get_memfile(handle, &m) ) { IOENC enc; if ( encoding ) { if ( !get_encoding(encoding, &enc) ) return FALSE; } else enc = m->encoding; if ( m->stream ) return alreadyOpen(handle, "to_atom"); if ( m->data ) { switch(enc) { case ENC_ISO_LATIN_1: case ENC_OCTET: return PL_unify_chars(atom, flags, m->data_size, m->data); case ENC_WCHAR: return PL_unify_wchars(atom, flags, m->data_size/sizeof(wchar_t), (pl_wchar_t*)m->data); case ENC_UTF8: return PL_unify_chars(atom, flags|REP_UTF8, m->data_size, m->data); default: assert(0); } } else return PL_unify_chars(atom, flags, 0, ""); } return FALSE; } static foreign_t memory_file_to_atom2(term_t handle, term_t atom) { return memory_file_to_text(handle, atom, 0, PL_ATOM); } static foreign_t memory_file_to_atom3(term_t handle, term_t atom, term_t encoding) { return memory_file_to_text(handle, atom, encoding, PL_ATOM); } static foreign_t memory_file_to_codes2(term_t handle, term_t atom) { return memory_file_to_text(handle, atom, 0, PL_CODE_LIST); } static foreign_t memory_file_to_codes3(term_t handle, term_t atom, term_t encoding) { return memory_file_to_text(handle, atom, encoding, PL_CODE_LIST); } #define MKATOM(n) ATOM_ ## n = PL_new_atom(#n); install_t install_memfile() { #if !_YAP_NOT_INSTALLED_ if ( PL_query(PL_QUERY_VERSION) <= 50505 ) { PL_warning("Requires SWI-Prolog version 5.5.6 or later"); return; } #endif FUNCTOR_memory_file1 = PL_new_functor(PL_new_atom("$memory_file"), 1); MKATOM(encoding); MKATOM(unknown); MKATOM(octet); MKATOM(ascii); MKATOM(iso_latin_1); MKATOM(text); MKATOM(utf8); MKATOM(unicode_be); MKATOM(unicode_le); MKATOM(wchar_t); MKATOM(read); MKATOM(write); MKATOM(free_on_close); PL_register_foreign("new_memory_file", 1, new_memory_file, 0); PL_register_foreign("free_memory_file", 1, free_memory_file, 0); PL_register_foreign("size_memory_file", 2, size_memory_file, 0); PL_register_foreign("open_memory_file", 3, open_memory_file, 0); PL_register_foreign("open_memory_file", 4, open_memory_file4, 0); PL_register_foreign("atom_to_memory_file", 2, atom_to_memory_file, 0); PL_register_foreign("memory_file_to_atom", 2, memory_file_to_atom2, 0); PL_register_foreign("memory_file_to_codes", 2, memory_file_to_codes2,0); PL_register_foreign("memory_file_to_atom", 3, memory_file_to_atom3, 0); PL_register_foreign("memory_file_to_codes", 3, memory_file_to_codes3,0); PL_register_foreign("utf8_position_memory_file", 3, utf8_position, 0); }