/** * 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; }