/**
* Request host: [string] listen: [string] pid: [string] callback: [block].
*
* Sets up Storm Server.
* Storm Server is an SCGI server. Both the Request Object Plugin and Storm Server
* are based on S. Losen's CCGI library (http://libccgi.sourceforge.net/doc.html)
* licensed LGPL.
*
* To set up a Storm Server, specify host (i.e. 'localhost'),
* a port to listen to (i.e. 9000) a pid file '/var/run/mypid.pid' and a
* callback block.
*
* Usage:
*
* Request host:'localhost' listen:4000 pid:'/var/run/storm.pid' callback: {
* Pen write: 'Content-type: text/html\n\n'.
* var fname := Command env: 'DOCUMENT_URI'.
* var script := File new: '/var/www/webapp'+fname.
* script include.
* }.
*
* Here we set up a server listening to port 4000. The callback prints out
* the content type header. Then, we extract the DOCUMENT URI, i.e. '/hello.ctr'
* and map this to a path '/var/www/webapp/hello.ctr'
*
* By default there is no output buffering, either create another callback or
* simply override the '<' or 'Pen' object to buffer instead of outputting
* directly.
*/
ctr_object* ctr_request_serve(ctr_object* myself, ctr_argument* argumentList) {
char* host;
char* pid;
int port;
int minidle = 8;
int maxidle = 8;
int maxreq = 1000;
int maxproc = 100;
ctr_object* val;
openlog("stormserver", 0, LOG_DAEMON);
val = ctr_request_internal_option(myself, "minidle");
if (val!=NULL) minidle = (int) ctr_internal_cast2number(val)->value.nvalue;
val = ctr_request_internal_option(myself, "maxidle");
if (val!=NULL) maxidle = (int) ctr_internal_cast2number(val)->value.nvalue;
val = ctr_request_internal_option(myself, "maxproc");
if (val!=NULL) maxproc = (int) ctr_internal_cast2number(val)->value.nvalue;
val = ctr_request_internal_option(myself, "maxreq");
if (val!=NULL) maxreq = (int) ctr_internal_cast2number(val)->value.nvalue;
host = ctr_heap_allocate_cstring( ctr_internal_cast2string( argumentList->object ) );
pid = ctr_heap_allocate_cstring( ctr_internal_cast2string( argumentList->next->next->object ) );
port = (int) round(ctr_internal_cast2number(argumentList->next->object)->value.nvalue);
ctr_heap_free( host );
ctr_heap_free( pid );
CtrStdSCGICB = argumentList->next->next->next->object;
CGI_prefork_server(host, port, pid,
/* maxproc */ maxproc,
/* minidle */ minidle,
/* maxidle */ maxidle,
/* maxreq */ maxreq, ctr_request_serve_callback);
return myself;
}
/**
* [List] + [List]
*
* Returns a new list, containing elements of itself and the other
* list.
*
* In other languages:
* Dutch: [Reeks] + [Reeks] | Geeft de reeks die bestaat uit de samenvoeging van gegeven reeksen.
*/
ctr_object* ctr_array_add(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* otherArray = argumentList->object;
ctr_object* newArray = ctr_array_new(CtrStdArray, NULL);
int i;
for(i = myself->value.avalue->tail; i<myself->value.avalue->head; i++) {
ctr_argument* pushArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* elnumArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_object* elnum = ctr_build_number_from_float((ctr_number) i);
elnumArg->object = elnum;
pushArg->object = ctr_array_get(myself, elnumArg);
ctr_array_push(newArray, pushArg);
ctr_heap_free( elnumArg );
ctr_heap_free( pushArg );
}
if (otherArray->info.type == CTR_OBJECT_TYPE_OTARRAY) {
for(i = otherArray->value.avalue->tail; i<otherArray->value.avalue->head; i++) {
ctr_argument* pushArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* elnumArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_object* elnum = ctr_build_number_from_float((ctr_number) i);
elnumArg->object = elnum;
pushArg->object = ctr_array_get(otherArray, elnumArg);
ctr_array_push(newArray, pushArg);
ctr_heap_free( elnumArg );
ctr_heap_free( pushArg );
}
}
return newArray;
}
/**
* [File] read
*
* Reads contents of a file. Send this message to a file to read the entire contents in
* one go. For big files you might want to prefer a streaming approach to avoid
* memory exhaustion (see readBytes etc).
*
* Usage:
*
* data := File new: '/path/to/mydata.csv', read.
*
* In the example above we read the contents of the entire CSV file callled mydata.csv
* in the variable called data.
*/
ctr_object* ctr_file_read(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0);
ctr_object* str;
ctr_size vlen, fileLen;
char* pathString;
char *buffer;
FILE* f;
if (path == NULL) return CtrStdNil;
vlen = path->value.svalue->vlen;
pathString = ctr_heap_allocate( sizeof(char) * ( vlen + 1 ) );
memcpy(pathString, path->value.svalue->value, vlen);
memcpy(pathString+vlen,"\0",1);
f = fopen(pathString, "rb");
ctr_heap_free( pathString );
if (!f) {
CtrStdFlow = ctr_build_string_from_cstring( "Unable to open file." );
CtrStdFlow->info.sticky = 1;
return CtrStdNil;
}
fseek(f, 0, SEEK_END);
fileLen=ftell(f);
fseek(f, 0, SEEK_SET);
buffer=(char *)ctr_heap_allocate(fileLen+1);
if (!buffer){
printf("Out of memory\n");
fclose(f);exit(1);
}
fread(buffer, fileLen, 1, f);
fclose(f);
str = ctr_build_string(buffer, fileLen);
ctr_heap_free( buffer );
return str;
}
/**
* [Map] each: [Block]
*
* Iterates over the map, passing key-value pairs to the specified block.
* Note that within an each/map block, '⛏' and '⚿' refer to the collection.
*
* In other languages:
* Dutch: [Lijst] elk: [Codeblok] | Past het blok code toe op elk paar uit de lijst.
*/
ctr_object* ctr_map_each(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* block = argumentList->object;
ctr_mapitem* m;
if (block->info.type != CTR_OBJECT_TYPE_OTBLOCK) {
CtrStdFlow = ctr_build_string_from_cstring( CTR_ERR_EXP_BLK );
CtrStdFlow->info.sticky = 1;
}
block->info.sticky = 1;
m = myself->properties->head;
while(m && !CtrStdFlow) {
ctr_argument* arguments = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* argument2 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* argument3 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
arguments->object = m->key;
argument2->object = m->value;
argument3->object = myself;
arguments->next = argument2;
argument2->next = argument3;
ctr_block_run(block, arguments, myself);
if (CtrStdFlow == CtrStdContinue) CtrStdFlow = NULL;
m = m->next;
ctr_heap_free( arguments );
ctr_heap_free( argument2 );
ctr_heap_free( argument3 );
}
if (CtrStdFlow == CtrStdBreak) CtrStdFlow = NULL;
block->info.mark = 0;
block->info.sticky = 0;
return myself;
}
/**
* [List] map: [Block].
*
* Iterates over the array. Passing each element as a key-value pair to the
* specified block.
* The map message will pass the following arguments to the block, the key,
* the value and a reference to the array itself. The last argument might seem
* redundant but allows for a more functional programming style. Instead of map,
* you can also use each:.
*
* Usage:
*
* files map: showName.
* files map: {
* :key :filename :files
* ✎ write: filename.
* }.
*
* files each: {
* :key :filename :files
* ✎ write: filename.
* }.
*
* In other languages:
* Dutch: [Reeks] lijst: [Codeblok] | Maakt van een reeks
*/
ctr_object* ctr_array_map(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* block = argumentList->object;
int i = 0;
if (block->info.type != CTR_OBJECT_TYPE_OTBLOCK) {
CtrStdFlow = ctr_build_string_from_cstring( CTR_ERR_EXP_BLK );
CtrStdFlow->info.sticky = 1;
}
for(i = myself->value.avalue->tail; i < myself->value.avalue->head; i++) {
ctr_argument* arguments = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* argument2 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* argument3 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
arguments->object = ctr_build_number_from_float((double) i);
argument2->object = *(myself->value.avalue->elements + i);
argument3->object = myself;
arguments->next = argument2;
argument2->next = argument3;
/* keep receiver in block object otherwise, GC will destroy it */
ctr_gc_internal_pin(block);
ctr_gc_internal_pin(myself);
ctr_gc_internal_pin(argument2->object);
ctr_block_run(block, arguments, myself);
ctr_heap_free( arguments );
ctr_heap_free( argument2 );
ctr_heap_free( argument3 );
if (CtrStdFlow == CtrStdContinue) CtrStdFlow = NULL;
if (CtrStdFlow) break;
}
if (CtrStdFlow == CtrStdBreak) CtrStdFlow = NULL; /* consume break */
return myself;
}
/**
* @internal
*
* Returns an array from the request, either for GET, POST or COOKIE.
*/
ctr_object* ctr_request_array(ctr_object* myself, ctr_argument* argumentList, CGI_varlist* varlist) {
ctr_object* cgiVarObject;
ctr_object* list;
char* cgiVar;
const CGI_value* value;
char* val;
ctr_argument* arg;
int i = 0;
list = ctr_array_new(CtrStdArray, NULL);
cgiVarObject = ctr_internal_cast2string(argumentList->object);
cgiVar = ctr_heap_allocate_cstring( cgiVarObject );
value = CGI_lookup_all(varlist, (const char*)cgiVar);
ctr_heap_free( cgiVar );
if (value == NULL) {
return list;
}
for (i = 0; value[i] != 0; i++) {
arg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
val = (char*) value[i];
arg->object = ctr_build_string_from_cstring(val);
ctr_array_push(list, arg);
ctr_heap_free( arg );
}
return list;
}
/**
* [Map] put: [Element] at: [Key]
*
* Puts a key-value pair in a map.
*
* Usage:
*
* map put: 'hello' at: 'world'.
*
* In other languages:
* Dutch: [Lijst] zet: [Object] bij: [Object]
* Zet het gespecificeerde object element bij de plek die bekend staat als
* het andere object. Net als bij een reeks, alleen in dit geval is het tweede
* Object de sleutel waarmee het eerste object weer uit de lijst gevist kan
* worden.
*/
ctr_object* ctr_map_put(ctr_object* myself, ctr_argument* argumentList) {
char* key;
long keyLen;
ctr_object* putKey;
ctr_object* putValue = argumentList->object;
ctr_argument* nextArgument = argumentList->next;
ctr_argument* emptyArgumentList = ctr_heap_allocate(sizeof(ctr_argument));
emptyArgumentList->next = NULL;
emptyArgumentList->object = NULL;
putKey = ctr_send_message(nextArgument->object, CTR_DICT_TOSTRING, strlen(CTR_DICT_TOSTRING), emptyArgumentList);
/* If developer returns something other than string (ouch, toString), then cast anyway */
if (putKey->info.type != CTR_OBJECT_TYPE_OTSTRING) {
putKey = ctr_internal_cast2string(putKey);
}
key = ctr_heap_allocate( putKey->value.svalue->vlen * sizeof( char ) );
keyLen = putKey->value.svalue->vlen;
memcpy(key, putKey->value.svalue->value, keyLen);
ctr_internal_object_delete_property(myself, ctr_build_string(key, keyLen), 0);
ctr_internal_object_add_property(myself, ctr_build_string(key, keyLen), putValue, 0);
ctr_heap_free( emptyArgumentList );
ctr_heap_free( key );
return myself;
}
ctr_object* ctr_json_create_object(json_t* root, ctr_object* gt) {
switch(json_typeof(root)) {
case JSON_OBJECT: {
ctr_object* sub = ctr_internal_create_object(CTR_OBJECT_TYPE_OTOBJECT);
ctr_set_link_all(sub, gt);
// size_t size;
const char *key;
json_t *value;
ctr_argument* argl = ctr_heap_allocate(sizeof(*argl));
argl->next = ctr_heap_allocate(sizeof(*argl));
// size = json_object_size(root);
json_object_foreach(root, key, value) {
char* k = (char*)key;
ctr_object* ko = ctr_build_string_from_cstring(k);
ctr_object* vo = ctr_json_create_object(value, gt);
argl->object = vo;
argl->next->object = ko;
sub = ctr_map_put(sub, argl);
}
ctr_heap_free(argl->next);
ctr_heap_free(argl);
return sub;
}
case JSON_ARRAY: {
ctr_object* arr = ctr_array_new(CtrStdArray, NULL);
ctr_argument* arg = ctr_heap_allocate(sizeof(ctr_argument));
size_t i;
size_t size = json_array_size(root);
for (i = 0; i < size; i++) {
arg->object = ctr_json_create_object(json_array_get(root, i), gt);
ctr_array_push(arr, arg);
}
ctr_heap_free(arg);
return arr;
}
case JSON_STRING: {
ctr_object* str = ctr_build_string((char*)json_string_value(root), json_string_length(root));
return str;
}
case JSON_INTEGER: {
return ctr_build_number_from_float(json_integer_value(root));
}
case JSON_REAL: {
return ctr_build_number_from_float(json_real_value(root));
}
case JSON_FALSE: {
return ctr_build_bool(0);
}
case JSON_TRUE: {
return ctr_build_bool(1);
}
case JSON_NULL: {
return ctr_build_nil();
}
default: {
CtrStdFlow = ctr_build_string_from_cstring("Unrecognized JSON type");
return CtrStdNil;
}
}
/**
* [List] copy
*
* Copies the list. The list object will answer this message by
* returning a shallow copy of itself. This means that the values in the
* newly returned list can be replaced or deleted without affecting
* the original one. However, modifying the values in the list will
* still cause their counterparts in the original list to be modified
* as well.
* In the example we replace the first item (1) in b with 999.
* The first element in a will still be 1 though because we have created
* copy b by sending the message 'copy' to a and assiging the result
* to b.
*
* Usage:
*
* ☞ a := List ← 1 ; 2 ; 3.
* ☞ b := a copy.
* b put: 999 at: 1.
*
* In other languages:
* Dutch: [Reeks] kopieer | Maakt een kopie van de reeks.
*/
ctr_object* ctr_array_copy(ctr_object* myself, ctr_argument* argumentList) {
ctr_size i = 0;
ctr_object* copy = ctr_array_new( CtrStdArray, argumentList );
ctr_argument* arg = ctr_heap_allocate(sizeof(ctr_argument));
ctr_argument* index = ctr_heap_allocate( sizeof( ctr_argument ) );
for(i = myself->value.avalue->tail; i<myself->value.avalue->head; i++) {
index->object = ctr_build_number_from_float((ctr_number) i);
arg->object = ctr_array_get( myself, index );
ctr_array_push( copy, arg );
}
ctr_heap_free( arg );
ctr_heap_free( index );
return copy;
}
/**
* [Map] at: [Key]
*
* Retrieves the value specified by the key from the map.
*
* In other languages:
* Dutch: [Lijst] bij: [Object] | Geeft de waarde bij de bijbehorende sleutel.
*/
ctr_object* ctr_map_get(ctr_object* myself, ctr_argument* argumentList) {
ctr_argument* emptyArgumentList;
ctr_object* searchKey;
ctr_object* foundObject;
emptyArgumentList = ctr_heap_allocate(sizeof(ctr_argument));
emptyArgumentList->next = NULL;
emptyArgumentList->object = NULL;
searchKey = argumentList->object;
/* Give developer a chance to define a key for array */
searchKey = ctr_send_message(searchKey, CTR_DICT_TOSTRING, strlen(CTR_DICT_TOSTRING), emptyArgumentList);
ctr_heap_free( emptyArgumentList );
/* If developer returns something other than string (ouch, toString), then cast anyway */
if (searchKey->info.type != CTR_OBJECT_TYPE_OTSTRING) {
searchKey = ctr_internal_cast2string(searchKey);
}
foundObject = ctr_internal_object_find_property(myself, searchKey, 0);
if (foundObject == NULL) foundObject = ctr_build_nil();
return foundObject;
}
/**
* [Map] string
*
* Returns a string representation of a map encoded in Citrine itself.
* This will give you an
* evallable representation of the map and all of its members.
* The sting method is automatically invoked when attempting to
* print a Map:
*
* Usage
*
* m := (Map new) put: 'hello' at: 'world'.
* x := m string.
* ✎ write: (Map new).
*
* In other languages:
* Dutch: [Lijst] tekst | Geeft tekstuele weergave van lijst (kan weer worden geevalueerd)
*/
ctr_object* ctr_map_to_string( ctr_object* myself, ctr_argument* argumentList) {
ctr_object* string;
ctr_mapitem* mapItem;
ctr_argument* newArgumentList;
string = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_MAP_NEW );
mapItem = myself->properties->head;
newArgumentList = ctr_heap_allocate( sizeof( ctr_argument ) );
while( mapItem ) {
newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_MAP_PUT );
ctr_string_append( string, newArgumentList );
if ( mapItem->value->info.type == CTR_OBJECT_TYPE_OTBOOL || mapItem->value->info.type == CTR_OBJECT_TYPE_OTNUMBER
|| mapItem->value->info.type == CTR_OBJECT_TYPE_OTNIL
) {
newArgumentList->object = mapItem->value;
ctr_string_append( string, newArgumentList );
} else if ( mapItem->value->info.type == CTR_OBJECT_TYPE_OTSTRING ) {
newArgumentList->object = ctr_build_string_from_cstring( "'" );
ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_string_quotes_escape( mapItem->value, newArgumentList );
ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_build_string_from_cstring( "'" );
ctr_string_append( string, newArgumentList );
} else {
newArgumentList->object = ctr_build_string_from_cstring( "(" );
ctr_string_append( string, newArgumentList );
newArgumentList->object = mapItem->value;
ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_build_string_from_cstring( ")" );
ctr_string_append( string, newArgumentList );
}
newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_MAP_PUT_AT );
ctr_string_append( string, newArgumentList );
if ( mapItem->key->info.type == CTR_OBJECT_TYPE_OTBOOL || mapItem->key->info.type == CTR_OBJECT_TYPE_OTNUMBER
|| mapItem->value->info.type == CTR_OBJECT_TYPE_OTNIL ) {
newArgumentList->object = mapItem->key;
ctr_string_append( string, newArgumentList );
} else if ( mapItem->key->info.type == CTR_OBJECT_TYPE_OTSTRING ) {
newArgumentList->object = ctr_build_string_from_cstring( "'" );
ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_string_quotes_escape( mapItem->key, newArgumentList );
ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_build_string_from_cstring( "'" );
ctr_string_append( string, newArgumentList );
} else {
newArgumentList->object = ctr_build_string_from_cstring( "(" );
ctr_string_append( string, newArgumentList );
newArgumentList->object = mapItem->key;
ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_build_string_from_cstring( ")" );
ctr_string_append( string, newArgumentList );
}
mapItem = mapItem->next;
if ( mapItem ) {
newArgumentList->object = ctr_build_string_from_cstring( ", " );
ctr_string_append( string, newArgumentList );
}
}
ctr_heap_free( newArgumentList );
return string;
}
/**
* [List] join: [String].
*
* Joins the elements of a list together in a string
* separated by a specified glue string. The example
* code results in the string: '1,2,3'.
*
* Usage:
*
* collection := List new.
* collection append: 1, append: 2, append 3.
* collection join: ','.
*
* In other languages:
* Dutch: [Reeks] samenvoegen: [Tekst] | Maakt een tekst door
* reekselementen samen te voegen met gespecificeerde koppelteken(s).
*/
ctr_object* ctr_array_join(ctr_object* myself, ctr_argument* argumentList) {
int i;
char* result;
ctr_size len = 0;
ctr_size pos;
ctr_object* o;
ctr_object* str;
ctr_object* resultStr;
ctr_object* glue = ctr_internal_cast2string(argumentList->object);
ctr_size glen = glue->value.svalue->vlen;
for(i=myself->value.avalue->tail; i<myself->value.avalue->head; i++) {
o = *( myself->value.avalue->elements + i );
str = ctr_internal_cast2string(o);
pos = len;
if (i == myself->value.avalue->tail) {
len = str->value.svalue->vlen;
result = ctr_heap_allocate(sizeof(char)*len);
} else {
len += str->value.svalue->vlen + glen;
result = ctr_heap_reallocate(result, sizeof(char)*len );
memcpy(result+pos, glue->value.svalue->value, glen);
pos += glen;
}
memcpy(result+pos, str->value.svalue->value, str->value.svalue->vlen);
}
resultStr = ctr_build_string(result, len);
if (i > myself->value.avalue->tail) ctr_heap_free( result );
return resultStr;
}
/**
* [Curl] cleanup.
*
* Destroy Curl handle in resource
*
**/
ctr_object* ctr_curl_cleanup(ctr_object* myself, ctr_argument* argumentList) {
curl_easy_cleanup((CURL *)myself->value.rvalue->ptr);
ctr_heap_free(myself->value.rvalue);
return myself;
}
int ctr_sort_cmp(const void * a, const void * b) {
ctr_argument* arg1 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* arg2 = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_object* result;
ctr_object* numResult;
arg1->next = arg2;
arg1->object = *((ctr_object**) a);
arg2->object = *((ctr_object**) b);
ctr_gc_internal_pin(temp_sorter);
ctr_gc_internal_pin(temp_self);
ctr_gc_internal_pin(arg1->object);
ctr_gc_internal_pin(temp_self);
result = ctr_block_run(temp_sorter, arg1, temp_self);
numResult = ctr_internal_cast2number(result);
ctr_heap_free( arg1 );
ctr_heap_free( arg2 );
return (int) numResult->value.nvalue;
}
/**
* [File] close.
*
* Closes the file represented by the recipient.
*
* Usage:
*
* f := File new: '/path/to/file.txt'.
* f open: 'r+'.
* f close.
*
* The example above opens and closes a file.
*/
ctr_object* ctr_file_close(ctr_object* myself, ctr_argument* argumentList) {
if (myself->value.rvalue == NULL) return myself;
if (myself->value.rvalue->type != 1) return myself;
if (myself->value.rvalue->ptr) {
fclose((FILE*)myself->value.rvalue->ptr);
}
ctr_heap_free( myself->value.rvalue );
myself->value.rvalue = NULL;
return myself;
}
/**
* @internal
*
* Returns a string from the request, either for GET, POST or COOKIE.
*/
ctr_object* ctr_request_string(ctr_object* myself, ctr_argument* argumentList, CGI_varlist* varlist) {
ctr_object* cgiVarObject;
char* cgiVar;
char* value;
cgiVarObject = ctr_internal_cast2string(argumentList->object);
cgiVar = ctr_heap_allocate_cstring( cgiVarObject );
value = (char*) CGI_lookup(varlist, (const char*)cgiVar);
ctr_heap_free( cgiVar );
if (value == NULL) return CtrStdNil;
return ctr_build_string_from_cstring(value);
}
/**
* @internal
*
* callback for SCGI server.
*/
void ctr_request_serve_callback() {
ctr_argument* argumentList;
argumentList = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
varlistGet = CGI_get_query(NULL);
varlistCookie = CGI_get_cookie(NULL);
varlistPost = CGI_get_post(NULL,"/tmp/_upXXXXXX");
ctr_block_run(CtrStdSCGICB, argumentList, CtrStdSCGICB);
ctr_heap_free( argumentList );
CGI_free_varlist(varlistGet);
CGI_free_varlist(varlistPost);
CGI_free_varlist(varlistCookie);
}
/**
* [List] replace: [Number] length: [Number] with: [List].
*
* Returns a copy of the list with the specified elements replaced.
* The first argument indicates the start index to begin the replacement.
* Here, 0 means the beginning of the list.
* The second argument (length)
* must indicate the number of elements to delete in the copy, counting
* from the starting point. Finally, one has to provide the replacement
* list as the third argument.
* If the replacement list is empty, the specified elements will only be
* removed from the copy.
* If the replacement is not an array an error will be thrown.
*
* Usage:
*
* ☞ buy := cakes
* replace: 1
* length: 2
* with: ( List ← 'cinnamon' ; 'pineapple' ).
*
* In other languages:
* Dutch: [Reeks] vervang: [Getal] lengte: [Getal] door: [Reeks]
* Vervangt een deel van de reeks door een andere reeks.
*/
ctr_object* ctr_array_splice(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* newArray = ctr_array_new(CtrStdArray, NULL);
ctr_object* start = ctr_internal_cast2number(argumentList->object);
ctr_object* deleteCount = ctr_internal_cast2number(argumentList->next->object);
ctr_object* replacement = argumentList->next->next->object;
ctr_object* remainder;
ctr_argument* sliceFromArg;
ctr_argument* sliceLengthArg;
ctr_argument* replacementArg;
ctr_argument* remainderArg;
ctr_size n;
if ( replacement->info.type != CTR_OBJECT_TYPE_OTARRAY ) {
CtrStdFlow = ctr_error_text( CTR_ERR_EXP_ARR );
return myself;
}
n = ( start->value.nvalue + deleteCount->value.nvalue );
sliceFromArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
sliceLengthArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
replacementArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
remainderArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
sliceFromArg->object = ctr_build_number_from_float(0);
sliceLengthArg->object = start;
sliceFromArg->next = sliceLengthArg;
newArray = ctr_array_from_length( myself, sliceFromArg );
replacementArg->object = replacement;
newArray = ctr_array_add(newArray, replacementArg);
sliceFromArg->object = ctr_build_number_from_float( n );
if ( n < (myself->value.avalue->head - myself->value.avalue->tail) ) {
sliceLengthArg->object = ctr_build_number_from_float( (myself->value.avalue->head - myself->value.avalue->tail) - n );
sliceFromArg->next = sliceLengthArg;
remainder = ctr_array_from_length( myself, sliceFromArg );
remainderArg->object = remainder;
newArray = ctr_array_add( newArray, remainderArg );
}
ctr_heap_free( sliceFromArg );
ctr_heap_free( sliceLengthArg );
ctr_heap_free( replacementArg );
ctr_heap_free( remainderArg );
return newArray;
}
/**
* [File] writeBytes: [String].
*
* Takes a string and writes the bytes in the string to the file
* object. Returns the number of bytes actually written.
*
* Usage:
*
* f := File new: '/path/to/file.txt'.
* f open: 'r+'.
* n := f writeBytes: 'Hello World'.
* f close.
*
* The example above writes 'Hello World' to the specified file as bytes.
* The number of bytes written is returned in variable n.
*/
ctr_object* ctr_file_write_bytes(ctr_object* myself, ctr_argument* argumentList) {
int bytes, written;
ctr_object* string2write;
char* buffer;
if (myself->value.rvalue == NULL) return myself;
if (myself->value.rvalue->type != 1) return myself;
string2write = ctr_internal_cast2string(argumentList->object);
buffer = ctr_heap_allocate_cstring( string2write );
bytes = string2write->value.svalue->vlen;
written = fwrite(buffer, sizeof(char), (int)bytes, (FILE*)myself->value.rvalue->ptr);
ctr_heap_free( buffer );
return ctr_build_number_from_float((double_t) written);
}
/**
* [List] fill: [Number] with: [Object]
*
* Fills the list with the specified number of objects.
*
* Usage:
*
* ☞ a := List new fill: 42 with: 'x'.
*
* In other languages:
* Dutch: [Reeks] vul: [Getal] met: [Object]
* Vult de reeks op met een gespecificeerd aantal elementen.
*/
ctr_object* ctr_array_fill( ctr_object* myself, ctr_argument* argumentList ) {
size_t n;
int i;
ctr_argument* newArgumentList;
n = ctr_internal_cast2number( argumentList->object )->value.nvalue;
newArgumentList = ctr_heap_allocate( sizeof(ctr_argument) );
newArgumentList->object = argumentList->next->object;
for(i = 0; i < n; i ++ ) {
ctr_array_push( myself, newArgumentList );
}
ctr_heap_free(newArgumentList);
return myself;
}
/**
* [List] by: [List].
*
* Combines the first list with the second one, thus creating
* a map. The keys of the newly generated map will be provided by the
* first list while the values are extracted from the second one.
* In the example we derive a temperature map from a pair of lists
* (cities and temperatures).
*
* Usage:
*
* ☞ city := List ← 'London' ; 'Paris' ; 'Berlin'.
* ☞ temperature := List ← '15' ; '16' ; '15'.
* ☞ weather := temperature by: city.
*
* In other languages:
* Dutch: [Reeks] per: [Reeks]
* Maakt een Lijst door elementen uit de eerste reeks te koppelen
* aan de elementen op dezelfde plek uit de tweede reeks.
*/
ctr_object* ctr_array_combine(ctr_object* myself, ctr_argument* argumentList) {
ctr_size i;
ctr_object* map = ctr_map_new( CtrStdMap, argumentList );
if (argumentList->object->info.type != CTR_OBJECT_TYPE_OTARRAY) {
return map;
}
ctr_argument* key = ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* value = ctr_heap_allocate( sizeof( ctr_argument ) );
ctr_argument* index = ctr_heap_allocate( sizeof( ctr_argument ) );
for(i = myself->value.avalue->tail; i<myself->value.avalue->head; i++) {
index->object = ctr_build_number_from_float((ctr_number) i);
key->object = ctr_array_get( myself, index );
value->object = ctr_array_get( argumentList->object, index );
key->next = value;
ctr_send_message( map, CTR_DICT_PUT_AT, strlen(CTR_DICT_PUT_AT), key);
ctr_map_put( map, key );
}
ctr_heap_free(key);
ctr_heap_free(value);
ctr_heap_free(index);
return map;
}
/**
* [List] from: [Begin] length: [End]
*
* Copies part of an array indicated by from and to and
* returns a new array consisting of a copy of this region.
*
* In other languages:
* Dutch: [Reeks] van: [Getal] lengte: [Getal] | Geeft subreeks.
*/
ctr_object* ctr_array_from_length(ctr_object* myself, ctr_argument* argumentList) {
ctr_argument* pushArg;
ctr_argument* elnumArg;
ctr_object* elnum;
ctr_object* startElement = ctr_internal_cast2number(argumentList->object);
ctr_object* count = ctr_internal_cast2number(argumentList->next->object);
int start = (int) startElement->value.nvalue;
int len = (int) count->value.nvalue;
int i = 0;
ctr_object* newArray = ctr_array_new(CtrStdArray, NULL);
for(i = start; i < start + len; i++) {
pushArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
elnumArg = (ctr_argument*) ctr_heap_allocate( sizeof( ctr_argument ) );
elnum = ctr_build_number_from_float((ctr_number) i);
elnumArg->object = elnum;
pushArg->object = ctr_array_get(myself, elnumArg);
ctr_array_push(newArray, pushArg);
ctr_heap_free( elnumArg );
ctr_heap_free( pushArg );
}
return newArray;
}
/**
* [Map] values
*
* Returns an array containing all the keys in the map.
* The order of the keys is undefined. Use the sort message
* to enforce a specific order.
*
* Usage:
*
* ☞ city := List ← 'London' ; 'Paris' ; 'Berlin'.
* ☞ temperature := List ← '15' ; '16' ; '15'.
*
* ☞ weather := temperature by: city.
* temperatures := weather values sort: {
* :a :b ↲ (a compare: b).
* }.
*
* In other languages:
* Dutch: [Lijst] waarden | Geeft alle waarden uit de lijst als een reeks.
*/
ctr_object* ctr_map_values(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* list;
ctr_mapitem* m;
ctr_argument* element;
list = ctr_array_new( CtrStdArray, argumentList );
m = myself->properties->head;
element = ctr_heap_allocate( sizeof( ctr_argument ) );
while( m ) {
element->object = m->value;
ctr_array_push( list, element );
m = m->next;
}
ctr_heap_free( element );
return list;
}
/**
* [File] open: [string]
*
* Open a file with using the specified mode.
*
* Usage:
*
* f := File new: '/path/to/file'.
* f open: 'r+'. #opens file for reading and writing
*
* The example above opens the file in f for reading and writing.
*/
ctr_object* ctr_file_open(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* pathObj = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0);
char* mode;
char* path;
FILE* handle;
ctr_resource* rs = ctr_heap_allocate(sizeof(ctr_resource));
ctr_object* modeStrObj = ctr_internal_cast2string( argumentList->object );
if ( myself->value.rvalue != NULL ) {
ctr_heap_free( rs );
CtrStdFlow = ctr_build_string_from_cstring( "File has already been opened." );
CtrStdFlow->info.sticky = 1;
return myself;
}
if ( pathObj == NULL ) return myself;
path = ctr_heap_allocate_cstring( pathObj );
mode = ctr_heap_allocate_cstring( modeStrObj );
handle = fopen(path,mode);
ctr_heap_free( path );
ctr_heap_free( mode );
rs->type = 1;
rs->ptr = handle;
myself->value.rvalue = rs;
return myself;
}
/**
* [File] delete
*
* Deletes the file.
*/
ctr_object* ctr_file_delete(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0);
ctr_size vlen;
char* pathString;
int r;
if (path == NULL) return myself;
vlen = path->value.svalue->vlen;
pathString = ctr_heap_allocate( sizeof( char ) * ( vlen + 1 ) );
memcpy(pathString, path->value.svalue->value, vlen);
memcpy(pathString+vlen,"\0",1);
r = remove(pathString);
ctr_heap_free( pathString );
if (r!=0) {
CtrStdFlow = ctr_build_string_from_cstring( "Unable to delete file." );
CtrStdFlow->info.sticky = 1;
return CtrStdNil;
}
return myself;
}
/**
* [File] exists
*
* Returns True if the file exists and False otherwise.
*/
ctr_object* ctr_file_exists(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0);
ctr_size vlen;
char* pathString;
FILE* f;
int exists;
if (path == NULL) return ctr_build_bool(0);
vlen = path->value.svalue->vlen;
pathString = ctr_heap_allocate(vlen + 1);
memcpy(pathString, path->value.svalue->value, vlen);
memcpy(pathString+vlen,"\0",1);
f = fopen(pathString, "r");
ctr_heap_free( pathString );
exists = (f != NULL );
if (f) {
fclose(f);
}
return ctr_build_bool(exists);
}
/**
* [File] readBytes: [Number].
*
* Reads a number of bytes from the file.
*
* Usage:
*
* f := File new: '/path/to/file.txt'.
* f open: 'r+'.
* x := f readBytes: 10.
* f close.
*
* The example above reads 10 bytes from the file represented by f
* and puts them in buffer x.
*/
ctr_object* ctr_file_read_bytes(ctr_object* myself, ctr_argument* argumentList) {
int bytes;
char* buffer;
ctr_object* result;
if (myself->value.rvalue == NULL) return myself;
if (myself->value.rvalue->type != 1) return myself;
bytes = ctr_internal_cast2number(argumentList->object)->value.nvalue;
if (bytes < 0) return ctr_build_string_from_cstring("");
buffer = (char*) ctr_heap_allocate(bytes);
if (buffer == NULL) {
CtrStdFlow = ctr_build_string_from_cstring("Cannot allocate memory for file buffer.");
CtrStdFlow->info.sticky = 1;
return ctr_build_string_from_cstring("");
}
fread(buffer, sizeof(char), (int)bytes, (FILE*)myself->value.rvalue->ptr);
result = ctr_build_string(buffer, bytes);
ctr_heap_free( buffer );
return result;
}
/**
* [List] string
*
* Returns a string representation of the list and its contents.
* This representation will be encoded in the Citrine language itself and can
* therefore be evaluated again.
* In the example: 'string' messages are implicitly
* send by some objects, for instance when
* attempting to write a List using a Pen.
*
* Usage:
*
* ☞ a := List ← 'hello' ; 'world'.
* ☞ b := a string.
* ☞ c := b evaluate.
*
* In other languages:
* Dutch: [Reeks] tekst
* Geeft een tekstuele versie van de reeks terug. Deze tekst kan opnieuw worden
* ingelezen door Citrine om er een reeks van te maken (evalueer).
*/
ctr_object* ctr_array_to_string( ctr_object* myself, ctr_argument* argumentList ) {
int i;
ctr_object* arrayElement;
ctr_argument* newArgumentList;
ctr_object* string = ctr_build_empty_string();
newArgumentList = ctr_heap_allocate( sizeof( ctr_argument ) );
if ( myself->value.avalue->tail == myself->value.avalue->head ) {
newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_ARRAY_NEW );
string = ctr_string_append( string, newArgumentList );
} else {
newArgumentList->object = ctr_build_string_from_cstring( CTR_DICT_CODEGEN_ARRAY_NEW_PUSH );
string = ctr_string_append( string, newArgumentList );
}
for(i=myself->value.avalue->tail; i<myself->value.avalue->head; i++) {
arrayElement = *( myself->value.avalue->elements + i );
if ( arrayElement->info.type == CTR_OBJECT_TYPE_OTBOOL || arrayElement->info.type == CTR_OBJECT_TYPE_OTNUMBER
|| arrayElement->info.type == CTR_OBJECT_TYPE_OTNIL ) {
newArgumentList->object = arrayElement;
string = ctr_string_append( string, newArgumentList );
} else if ( arrayElement->info.type == CTR_OBJECT_TYPE_OTSTRING ) {
newArgumentList->object = ctr_build_string_from_cstring("'");
string = ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_string_quotes_escape( arrayElement, newArgumentList );
string = ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_build_string_from_cstring("'");
string = ctr_string_append( string, newArgumentList );
} else {
newArgumentList->object = ctr_build_string_from_cstring("(");
ctr_string_append( string, newArgumentList );
newArgumentList->object = arrayElement;
string = ctr_string_append( string, newArgumentList );
newArgumentList->object = ctr_build_string_from_cstring(")");
ctr_string_append( string, newArgumentList );
}
if ( (i + 1 )<myself->value.avalue->head ) {
newArgumentList->object = ctr_build_string_from_cstring(" ; ");
string = ctr_string_append( string, newArgumentList );
}
}
ctr_heap_free( newArgumentList );
return string;
}
/**
* [File] include
*
* Includes the file as a piece of executable code.
*/
ctr_object* ctr_file_include(ctr_object* myself, ctr_argument* argumentList) {
ctr_object* path = ctr_internal_object_find_property(myself, ctr_build_string_from_cstring( "path" ), 0);
ctr_tnode* parsedCode;
ctr_size vlen;
char* pathString;
char* prg;
uint64_t program_size = 0;
if (path == NULL) return myself;
vlen = path->value.svalue->vlen;
pathString = ctr_heap_allocate_tracked(sizeof(char)*(vlen+1)); //needed until end, pathString appears in stracktrace
memcpy(pathString, path->value.svalue->value, vlen);
memcpy(pathString+vlen,"\0",1);
prg = ctr_internal_readf(pathString, &program_size);
parsedCode = ctr_cparse_parse(prg, pathString);
ctr_heap_free( prg );
ctr_cwlk_subprogram++;
ctr_cwlk_run(parsedCode);
ctr_cwlk_subprogram--;
return myself;
}
/**
* [Curl] perform.
*
* Performs a blocking file transfer
*
**/
ctr_object* ctr_curl_perform(ctr_object* myself, ctr_argument* argumentList) {
FILE *temp = tmpfile();
curl_easy_setopt(myself->value.rvalue->ptr, CURLOPT_WRITEDATA, temp);
CURLcode code = curl_easy_perform(myself->value.rvalue->ptr);
if (code != CURLE_OK)
CtrStdFlow = ctr_error_text("Received Curl error code");
fseek(temp, 0, SEEK_END);
ctr_size fileLen = ftell(temp);
fseek(temp, 0, SEEK_SET);
char *buffer = (char *)ctr_heap_allocate(fileLen + 1);
if (!buffer) {
printf("Out of memory\n");
fclose(temp);
exit(1);
}
fread(buffer, fileLen, 1, temp);
fclose(temp);
ctr_object *str = ctr_build_string(buffer, fileLen);
ctr_heap_free(buffer);
return str;
}
