1 #include <Rinternals.h>
2
3 static int total_open_writers = 0;
4
fin_file_writer(SEXP ptr)5 void fin_file_writer(SEXP ptr){
6 FILE *fp = R_ExternalPtrAddr(ptr);
7 if(fp != NULL){
8 fclose(fp);
9 R_ClearExternalPtr(ptr);
10 total_open_writers--;
11 }
12 }
13
R_write_file_writer(SEXP ptr,SEXP buf,SEXP close)14 SEXP R_write_file_writer(SEXP ptr, SEXP buf, SEXP close){
15 FILE *fp = R_ExternalPtrAddr(ptr);
16 if(fp == NULL){
17 SEXP path = R_ExternalPtrTag(ptr);
18 fp = fopen(CHAR(STRING_ELT(path, 0)), "wb");
19 if(!fp)
20 Rf_error("Failed to open file: %s", CHAR(STRING_ELT(path, 0)));
21 R_SetExternalPtrAddr(ptr, fp);
22 total_open_writers++;
23 }
24 size_t len = fwrite(RAW(buf), 1, Rf_xlength(buf), fp);
25 if(Rf_asLogical(close)){
26 fin_file_writer(ptr);
27 } else if(Rf_length(buf)) {
28 fflush(fp);
29 }
30 return ScalarInteger(len);
31 }
32
R_new_file_writer(SEXP path)33 SEXP R_new_file_writer(SEXP path){
34 SEXP ptr = PROTECT(R_MakeExternalPtr(NULL, path, R_NilValue));
35 R_RegisterCFinalizerEx(ptr, fin_file_writer, TRUE);
36 setAttrib(ptr, R_ClassSymbol, mkString("file_writer"));
37 UNPROTECT(1);
38 return ptr;
39 }
40
R_total_writers()41 SEXP R_total_writers(){
42 return(ScalarInteger(total_open_writers));
43 }
44