/**
module_read_path : string list -> name:string -> loader:object -> 'module
<doc>
Read a module using the specified search path.
</doc>
**/
static value module_read_path( value path, value name, value loader ) {
FILE *f;
value fname;
char *mname, *ext;
neko_module *m;
val_check(name,string);
val_check(loader,object);
mname = val_string(name);
ext = strrchr(mname,'.');
if( ext && ext[1] == 'n' && ext[2] == 0 )
fname = neko_select_file(path,mname,"");
else
fname = neko_select_file(path,mname,".n");
f = fopen(val_string(fname),"rb");
if( f == NULL ) {
buffer b = alloc_buffer("Module not found : ");
buffer_append(b,mname);
bfailure(b);
}
m = neko_read_module(neko_file_reader,f,loader);
fclose(f);
if( m == NULL ) {
buffer b = alloc_buffer("Invalid module : ");
val_buffer(b,name);
bfailure(b);
}
m->name = alloc_string(val_string(name));
return alloc_abstract(neko_kind_module,m);
}
/**
connect : { host => string, port => int, user => string, pass => string, socket => string? } -> 'connection
<doc>Connect to a database using the connection informations</doc>
**/
static value connect_mysql( value params ) {
value host, port, user, pass, socket;
val_check(params,object);
host = val_field(params,val_id("host"));
port = val_field(params,val_id("port"));
user = val_field(params,val_id("user"));
pass = val_field(params,val_id("pass"));
socket = val_field(params,val_id("socket"));
val_check(host,string);
val_check(port,int);
val_check(user,string);
val_check(pass,string);
if( !val_is_string(socket) && !val_is_null(socket) )
neko_error();
{
connection *c = (connection*)alloc(sizeof(connection));
value v;
c->m = mysql_init(NULL);
c->conv_string = NULL;
c->conv_date = NULL;
c->conv_bytes = NULL;
if( mysql_real_connect(c->m,val_string(host),val_string(user),val_string(pass),NULL,val_int(port),val_is_null(socket)?NULL:val_string(socket),0) == NULL ) {
buffer b = alloc_buffer("Failed to connect to mysql server : ");
buffer_append(b,mysql_error(c->m));
mysql_close(c->m);
bfailure(b);
}
v = alloc_abstract(k_connection,c);
val_gc(v,free_connection);
return v;
}
}
static value loader_loadprim( value prim, value nargs ) {
value o = val_this();
value libs;
val_check(o,object);
val_check(prim,string);
val_check(nargs,int);
libs = val_field(o,id_loader_libs);
val_check_kind(libs,k_loader_libs);
if( val_int(nargs) >= 10 || val_int(nargs) < -1 )
neko_error();
{
neko_vm *vm = NEKO_VM();
void *ptr = load_primitive(val_string(prim),val_int(nargs),val_field(o,id_path),(liblist**)(void*)&val_data(libs));
vfunction *f;
if( ptr == NULL ) {
buffer b = alloc_buffer("Primitive not found : ");
val_buffer(b,prim);
buffer_append(b,"(");
val_buffer(b,nargs);
buffer_append(b,")");
bfailure(b);
}
f = (vfunction*)alloc_function(ptr,val_int(nargs),val_string(copy_string(val_string(prim),val_strlen(prim))));
if( vm->pstats && val_int(nargs) <= 6 ) {
value env = alloc_array(2);
val_array_ptr(env)[0] = f->module;
val_array_ptr(env)[1] = (value)(((int_val)f->addr) | 1);
f->addr = stats_proxy;
f->env = env;
}
return (value)f;
}
}
/**
regexp_new_options : reg:string -> options:string -> 'regexp
<doc>Build a new regexpr with the following options :
<ul>
<li>i : case insensitive matching</li>
<li>s : . match anything including newlines</li>
<li>m : treat the input as a multiline string</li>
<li>u : run in utf8 mode</li>
<li>g : turn off greedy behavior</li>
</ul>
</doc>
**/
static value regexp_new_options( value s, value opt ) {
val_check(s,string);
val_check(opt,string);
{
value v;
const char *error;
int err_offset;
pcre *p;
pcredata *pdata;
const char *o = val_string(opt);
int options = 0;
while( *o ) {
switch( *o++ ) {
case 'i':
options |= PCRE_CASELESS;
break;
case 's':
options |= PCRE_DOTALL;
break;
case 'm':
options |= PCRE_MULTILINE;
break;
case 'u':
options |= PCRE_UTF8;
break;
case 'g':
options |= PCRE_UNGREEDY;
break;
default:
return alloc_null();
break;
}
}
p = pcre_compile(val_string(s),options,&error,&err_offset,NULL);
if( p == NULL ) {
buffer b = alloc_buffer("Regexp compilation error : ");
buffer_append(b,error);
buffer_append(b," in ");
val_buffer(b,s);
bfailure(b);
}
v = alloc_abstract(k_regexp,malloc(sizeof(pcredata)));
pdata = PCRE(v);
pdata->r = p;
pdata->str = alloc_null();
val_gc_add_root(&pdata->str);
pdata->nmatchs = 0;
pcre_fullinfo(p,NULL,PCRE_INFO_CAPTURECOUNT,&pdata->nmatchs);
pdata->nmatchs++;
pdata->matchs = (int*)malloc(sizeof(int) * 3 * pdata->nmatchs);
val_gc(v,free_regexp);
return v;
}
}
/**
escape : 'connection -> string -> string
<doc>Escape the string for inserting into a SQL request</doc>
**/
static value escape( value o, value s ) {
int len;
value sout;
val_check_kind(o,k_connection);
val_check(s,string);
len = val_strlen(s) * 2;
sout = alloc_empty_string(len);
len = mysql_real_escape_string(CNX(o)->m,val_string(sout),val_string(s),val_strlen(s));
if( len < 0 ) {
buffer b = alloc_buffer("Unsupported charset : ");
buffer_append(b,mysql_character_set_name(CNX(o)->m));
bfailure(b);
}
val_set_length(sout,len);
val_string(sout)[len] = 0;
return sout;
}
static void open_module( value path, const char *mname, reader *r, readp *p ) {
FILE *f;
value fname;
char *ext = strrchr(mname,'.');
if( ext && ext[1] == 'n' && ext[2] == 0 )
fname = neko_select_file(path,mname,"");
else
fname = neko_select_file(path,mname,".n");
f = fopen(val_string(fname),"rb");
if( f == NULL ) {
buffer b = alloc_buffer("Module not found : ");
buffer_append(b,mname);
bfailure(b);
}
*r = neko_file_reader;
*p = f;
}
static void xml_error( const char *xml, const char *p, int *line, const char *msg ) {
buffer b = alloc_buffer("Xml parse error : ");
int l = (int)strlen(p);
int nchars = 30;
buffer_append(b,msg);
buffer_append(b," at line ");
val_buffer(b,alloc_int(*line));
buffer_append(b," : ");
if( p != xml )
buffer_append(b,"...");
buffer_append_sub(b,p,(l < nchars)?l:nchars);
if( l > nchars )
buffer_append(b,"...");
if( l == 0 )
buffer_append(b,"<eof>");
bfailure(b);
}
static value alloc_result( connection *c, MYSQL_RES *r ) {
result *res = (result*)alloc(sizeof(result));
value o = alloc_abstract(k_result,res);
int num_fields = mysql_num_fields(r);
int i,j;
MYSQL_FIELD *fields = mysql_fetch_fields(r);
res->r = r;
res->conv_date = c->conv_date;
res->conv_bytes = c->conv_bytes;
res->conv_string = c->conv_string;
res->current = NULL;
res->nfields = num_fields;
res->fields_ids = (field*)alloc_private(sizeof(field)*num_fields);
res->fields_convs = (CONV*)alloc_private(sizeof(CONV)*num_fields);
for(i=0;i<num_fields;i++) {
field id;
if( strchr(fields[i].name,'(') )
id = val_id("???"); // looks like an inner request : prevent hashing + cashing it
else {
id = val_id(fields[i].name);
for(j=0;j<i;j++)
if( res->fields_ids[j] == id ) {
buffer b = alloc_buffer("Error, same field ids for : ");
buffer_append(b,fields[i].name);
buffer_append(b,":");
val_buffer(b,alloc_int(i));
buffer_append(b," and ");
buffer_append(b,fields[j].name);
buffer_append(b,":");
val_buffer(b,alloc_int(j));
buffer_append(b,".");
bfailure(b);
}
}
res->fields_ids[i] = id;
res->fields_convs[i] = convert_type(fields[i].type,fields[i].flags,fields[i].length);
}
val_gc(o,free_result);
return o;
}
static value loader_loadmodule( value mname, value vthis ) {
value o = val_this();
value cache;
val_check(o,object);
val_check(mname,string);
val_check(vthis,object);
cache = val_field(o,id_cache);
val_check(cache,object);
{
reader r;
readp p;
neko_module *m;
neko_vm *vm = NEKO_VM();
field mid = val_id(val_string(mname));
value mv = val_field(cache,mid);
if( val_is_kind(mv,neko_kind_module) ) {
m = (neko_module*)val_data(mv);
return m->exports;
}
open_module(val_field(o,id_path),val_string(mname),&r,&p);
if( vm->fstats ) vm->fstats(vm,"neko_read_module",1);
m = neko_read_module(r,p,vthis);
if( vm->fstats ) vm->fstats(vm,"neko_read_module",0);
close_module(p);
if( m == NULL ) {
buffer b = alloc_buffer("Invalid module : ");
val_buffer(b,mname);
bfailure(b);
}
m->name = alloc_string(val_string(mname));
mv = alloc_abstract(neko_kind_module,m);
alloc_field(cache,mid,mv);
if( vm->fstats ) vm->fstats(vm,val_string(mname),1);
neko_vm_execute(neko_vm_current(),m);
if( vm->fstats ) vm->fstats(vm,val_string(mname),0);
return m->exports;
}
}
static void error( MYSQL *m, const char *msg ) {
buffer b = alloc_buffer(msg);
buffer_append(b," ");
buffer_append(b,mysql_error(m));
bfailure(b);
}
static value unserialize_rec( sbuffer *b, value loader ) {
switch( read_char(b) ) {
case 'N':
return val_null;
case 'T':
return val_true;
case 'F':
return val_false;
case 'i':
return alloc_int(read_int(b));
case 'I':
return alloc_int32(read_int(b));
case 'f':
{
tfloat d;
read_str(b,sizeof(tfloat),&d);
return alloc_float(d);
}
case 's':
{
int l = read_int(b);
value v;
if( l < 0 || l > max_string_size )
ERROR();
v = alloc_empty_string(l);
add_ref(b,v);
read_str(b,l,(char*)val_string(v));
return v;
}
case 'o':
{
int f;
value o = alloc_object(NULL);
add_ref(b,o);
while( (f = read_int(b)) != 0 ) {
value fval = unserialize_rec(b,loader);
alloc_field(o,(field)f,fval);
}
switch( read_char(b) ) {
case 'p':
{
value v = unserialize_rec(b,loader);
if( !val_is_object(v) )
ERROR();
((vobject*)o)->proto = (vobject*)v;
}
break;
case 'z':
break;
default:
ERROR();
}
return o;
}
case 'r':
{
int n = read_int(b);
if( n < 0 || n >= b->nrefs )
ERROR();
return b->trefs[b->nrefs - n - 1];
}
case 'a':
{
int i;
int n = read_int(b);
value o;
value *t;
if( n < 0 || n > max_array_size )
ERROR();
o = alloc_array(n);
t = val_array_ptr(o);
add_ref(b,o);
for(i=0;i<n;i++)
t[i] = unserialize_rec(b,loader);
return o;
}
case 'p':
{
int nargs = read_int(b);
vfunction *f = (vfunction*)alloc_function((void*)1,nargs,NULL);
vfunction *f2;
value name;
add_ref(b,(value)f);
name = unserialize_rec(b,loader);
f2 = (vfunction*)val_ocall2(loader,id_loadprim,name,alloc_int(nargs));
if( !val_is_function(f2) || val_fun_nargs(f2) != nargs )
failure("Loader returned not-a-function");
f->t = f2->t;
f->addr = f2->addr;
f->module = f2->module;
return (value)f;
}
case 'L':
{
vfunction *f = (vfunction*)alloc_function((void*)1,0,NULL);
value mname;
int pos;
int nargs;
value env;
add_ref(b,(value)f);
mname = unserialize_rec(b,loader);
pos = read_int(b);
nargs = read_int(b);
env = unserialize_rec(b,loader);
if( !val_is_array(env) )
ERROR();
{
value exp = val_ocall2(loader,id_loadmodule,mname,loader);
value mval;
unsigned int i;
int_val *mpos;
neko_module *m;
if( !val_is_object(exp) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," is not an object");
bfailure(b);
}
mval = val_field(exp,id_module);
if( !val_is_kind(mval,neko_kind_module) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," has invalid type");
bfailure(b);
}
m = (neko_module*)val_data(mval);
mpos = m->code + pos;
for(i=0;i<m->nglobals;i++) {
vfunction *g = (vfunction*)m->globals[i];
if( val_is_function(g) && g->addr == mpos && g->module == m && g->nargs == nargs ) {
f->t = VAL_FUNCTION;
f->env = env;
f->addr = mpos;
f->nargs = nargs;
f->module = m;
return (value)f;
}
}
{
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," has been modified");
bfailure(b);
}
}
return val_null;
}
case 'x':
{
value mname = unserialize_rec(b,loader);
value data = unserialize_rec(b,loader);
value exports = val_ocall2(loader,id_loadmodule,mname,loader);
value s;
if( !val_is_object(exports) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," is not an object");
bfailure(b);
}
s = val_field(exports,id_unserialize);
if( !val_is_function(s) || (val_fun_nargs(s) != 1 && val_fun_nargs(s) != VAR_ARGS) ) {
buffer b = alloc_buffer("module ");
val_buffer(b,mname);
buffer_append(b," has invalid __unserialize function");
}
s = val_call1(s,data);
add_ref(b,s);
return s;
}
case 'h':
{
int i;
vhash *h = (vhash*)alloc(sizeof(vhash));
h->ncells = read_int(b);
h->nitems = read_int(b);
h->cells = (hcell**)alloc(sizeof(hcell*)*h->ncells);
for(i=0;i<h->ncells;i++)
h->cells[i] = NULL;
for(i=0;i<h->nitems;i++) {
hcell **p;
hcell *c = (hcell*)alloc(sizeof(hcell));
c->hkey = read_int(b);
c->key = unserialize_rec(b,loader);
c->val = unserialize_rec(b,loader);
c->next = NULL;
p = &h->cells[c->hkey % h->ncells];
while( *p != NULL )
p = &(*p)->next;
*p = c;
}
return alloc_abstract(k_hash,h);
}
default:
ERROR();
return val_null;
}
}
static void *load_primitive( const char *prim, int nargs, value path, liblist **libs ) {
char *pos = strchr(prim,'@');
int len;
liblist *l;
PRIM0 ptr;
if( pos == NULL )
return NULL;
l = *libs;
*pos = 0;
len = (int)strlen(prim) + 1;
# ifndef NEKO_STANDALONE
while( l != NULL ) {
if( memcmp(l->name,prim,len) == 0 )
break;
l = l->next;
}
# endif
if( l == NULL ) {
void *h;
value pname = pname = neko_select_file(path,prim,".ndll");
#ifdef NEKO_STANDALONE
# ifdef NEKO_WINDOWS
h = (void*)GetModuleHandle(NULL);
# else
h = dlopen(NULL,RTLD_LAZY);
# endif
#else
h = dlopen(val_string(pname),RTLD_LAZY);
#endif
if( h == NULL ) {
buffer b = alloc_buffer("Failed to load library : ");
val_buffer(b,pname);
#ifndef NEKO_WINDOWS
buffer_append(b," (");
buffer_append(b,dlerror());
buffer_append(b,")");
#endif
*pos = '@';
bfailure(b);
}
l = (liblist*)alloc(sizeof(liblist));
l->handle = h;
l->name = alloc_private(len);
memcpy(l->name,prim,len);
l->next = *libs;
*libs = l;
ptr = (PRIM0)dlsym(l->handle,"__neko_entry_point");
if( ptr != NULL )
((PRIM0)ptr())();
}
*pos++ = '@';
{
char buf[100];
if( strlen(pos) > 90 )
return NULL;
if( nargs == VAR_ARGS )
sprintf(buf,"%s__MULT",pos);
else
sprintf(buf,"%s__%d",pos,nargs);
ptr = (PRIM0)dlsym(l->handle,buf);
if( ptr == NULL )
return NULL;
return ptr();
}
}
