view release on metacpan or  search on metacpan

lib/File/Map.xs  view on Meta::CPAN

	{ STR_WITH_LEN("crlf"), 1 },
	{ STR_WITH_LEN("stdio"), 1 },
	{ STR_WITH_LEN("flock"), 1 },
	{ STR_WITH_LEN("creat"), 1 },
	{ STR_WITH_LEN("mmap"), 1 },
};

static int S_map_get(pTHX_ const map table, size_t table_size, const char* name, int fallback) {
	int i;
	for (i = 0; i < table_size; ++i) {
		if (strEQ(name, table[i].key))
			return table[i].value;
	}
	return fallback;
}
#define map_get(table, name, default) S_map_get(aTHX_ table, sizeof table / sizeof *table, name, default)

int S_check_layers(pTHX_ PerlIO* fh) {
	PerlIO* current;
	if (PerlIO_fileno(fh) < 0)
		Perl_croak(aTHX_ "Can't map fake filehandle");
	for (current = fh; *current; current = PerlIONext(current)) {
		if (!map_get(mappable, (*current)->tab->name, 0) || (*current)->flags & PERLIO_F_CRLF)
			Perl_croak(aTHX_ "Shouldn't map non-binary filehandle");
	}
	return (*fh)->flags & PERLIO_F_UTF8;
}
#define check_layers(fh) S_check_layers(aTHX_ fh)

size_t S_get_length(pTHX_ PerlIO* fh, Off_t offset, SV* length_sv) {
	Stat_t info;
	Fstat(PerlIO_fileno(fh), &info);
	size_t length = SvOK(length_sv) ? SvIV(length_sv) : info.st_size - offset;
	size_t end = offset + length;
	if (offset < 0 || end > info.st_size && !S_ISCHR(info.st_mode))
		Perl_croak(aTHX_ "Window (%ld,%lu) is outside the file", offset, length);
	return length;
}
#define get_length(fh, offset, length) S_get_length(aTHX_ fh, offset, length)

#define READONLY sv_2mortal(newSVpvs("<"))
#define undef &PL_sv_undef

void S_map_handle(pTHX_ SV* var, PerlIO* fh, SV* mode, Off_t offset, SV* length_sv) {
	int utf8 = check_layers(fh);
	size_t length = get_length(fh, offset, length_sv);
	mmap_impl(var, length, protection_sv(mode), MAP_SHARED | MAP_FILE, PerlIO_fileno(fh), offset, utf8);
}
#define map_handle(var, fh, mode, offset, length) S_map_handle(aTHX_ var, fh, mode, offset, length)

void S_map_file(pTHX_ SV* var, SV* filename, SV* mode, Off_t offset, SV* length_sv) {
	STRLEN mode_len;
	const char* mode_raw = SvPV(mode, mode_len);
	if (memchr(mode_raw, ':', mode_len) == NULL) {
		SV* newmode = sv_2mortal(newSVsv(mode));
		sv_catpvs(newmode, ":raw");
		mode_raw = SvPV(newmode, mode_len);
	}
	GV* gv = MUTABLE_GV(sv_2mortal(newSV_type(SVt_NULL)));
	gv_init_pvn(gv, CopSTASH(PL_curcop),  "__ANONIO__", 10, GV_ADDMULTI);
	if (!do_openn(gv, mode_raw, mode_len, 0, 0, 0, NULL, &filename, 1))
		Perl_croak(aTHX_ "Couldn't open file %s: %s", SvPV_nolen(filename), strerror(errno));
	map_handle(var, IoIFP(GvIO(gv)), mode, offset, length_sv);
}
#define map_file(var, filename, mode, offset, length) S_map_file(aTHX_ var, filename, mode, offset, length)

static const map flags = {
	{ STR_WITH_LEN("shared") , MAP_SHARED },
	{ STR_WITH_LEN("private"), MAP_PRIVATE },
};

void S_map_anonymous(pTHX_ SV* var, size_t length, const char* flag_name) {
	int flag = map_get(flags, flag_name, -1);
	if (flag == -1)
		Perl_croak(aTHX_ "No such flag '%s'", flag_name);
	if (length == 0)
		Perl_croak(aTHX_ "Zero length specified for anonymous map");
	mmap_impl(var, length, PROT_READ | PROT_WRITE, flag | MAP_ANONYMOUS, -1, 0, 0);
}
#define map_anonymous(var, length, flag_name) S_map_anonymous(aTHX_ var, length, flag_name)

void S_sys_map(pTHX_ SV* var, size_t length, int protection, int flags, SV* fh, Off_t offset) {
	if (flags & MAP_ANONYMOUS)
		mmap_impl(var, length, protection, flags, -1, offset, 0);
	else {
		PerlIO* pio = IoIFP(sv_2io(fh)); // XXX error check
		int utf8 = check_layers(pio);
		int fd = PerlIO_fileno(pio);
		mmap_impl(var, length, protection, flags, fd, offset, utf8);
	}
}
#define sys_map(var, length, protection, flags, fh, offset) S_sys_map(aTHX_ var, length, protection, flags, fh, offset)

void S_sync(pTHX_ SV* var, bool sync) {
	struct mmap_info* info = get_mmap_magic(var, "sync");
	if (EMPTY_MAP(info))
		return;
	if (SvREADONLY(var) && ckWARN(WARN_IO))
		Perl_warn(aTHX_ "Syncing a readonly map makes no sense");
	if (msync(info->real_address, info->real_length, sync ? MS_SYNC : MS_ASYNC ) == -1)
		die_sys("Could not sync: %s");
}
#define sync(var, sync) S_sync(aTHX_ var, sync)

#ifdef __linux__
void S_remap(pTHX_ SV* var, size_t new_size) {
	struct mmap_info* info = get_mmap_magic(var, "remap");
	ptrdiff_t correction = info->real_length - info->fake_length;
	void* new_address;
CODE:
#ifdef USE_ITHREADS
	if (info->count != 1)
		Perl_croak(aTHX_ "Can't remap a shared mapping");
#endif
	if (EMPTY_MAP(info))
		Perl_croak(aTHX_ "Can't remap empty map"); /* XXX */
	if (new_size == 0)
		Perl_croak(aTHX_ "Can't remap to zero");
	if ((info->flags & (MAP_ANONYMOUS|MAP_SHARED)) == (MAP_ANONYMOUS|MAP_SHARED))
		Perl_croak(aTHX_ "Can't remap a shared anonymous mapping");
	if ((new_address = mremap(info->real_address, info->real_length, new_size + correction, MREMAP_MAYMOVE)) == MAP_FAILED)