source: branches/1.3/lang/R/Rappture/src/RpLibraryRInterface.cc @ 3739

Last change on this file since 3739 was 3739, checked in by gah, 11 years ago

bandaid R bindings for R 3.0.1
File size: 16.7 KB
Line 
1/*
2 * ----------------------------------------------------------------------
3 *  INTERFACE: R Rappture Library Source
4 *
5 * ======================================================================
6 *  AUTHOR:  Derrick Kearney, Purdue University
7 *  Copyright (c) 2004-2012  HUBzero Foundation, LLC
8 *
9 *  See the file "license.terms" for information on usage and
10 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 * ======================================================================
12 */
13
14#include "RpLibrary.h"
15#include "RpBindingsDict.h"
16
17#include "RpLibraryRInterface.h"
18
19#ifdef __cplusplus
20extern "C" {
21#endif
22
23static void
24rp_lib_finalizer(SEXP ptr)
25{
26    if (!R_ExternalPtrAddr(ptr)) {
27        return;
28    }
29#ifdef notdef
30    /* Until we figure this out, don't delete the library object.  R is
31     * calling the finalizer on every method of the library object.  This is a
32     * problem only if someone explicitly deletes the library object from
33     * R. */
34    RpLibrary* lib;
35    lib = (RpLibrary *)R_ExternalPtrAddr(ptr);
36    if (lib != NULL) {
37        delete lib;
38    }
39#endif
40    R_ClearExternalPtr(ptr);
41}
42
43
44
45/**********************************************************************/
46// FUNCTION: rp_lib(const char* filePath, int handle)
47/// Open the file at 'filePath' and return Rappture Library Object.
48/**
49 */
50
51SEXP
52RPRLib(SEXP fname)
53{
54    RpLibrary* lib = NULL;
55    int handle = -1;
56    SEXP ans, ptr;
57
58    ans = allocVector(INTSXP,1);
59    PROTECT(ans);
60    INTEGER(ans)[0] = -1;
61
62    if (!isString(fname) || length(fname) != 1) {
63        error("fname is not a single string");
64        UNPROTECT(1);
65        return ans;
66    }
67
68    // create a RapptureIO object and store in dictionary
69    lib = new RpLibrary(CHAR(STRING_ELT(fname, 0)));
70    if (lib == NULL) {
71        error("could not allocate new RpLibrary object");
72        UNPROTECT(1);
73        return ans;
74    }
75
76    ptr = R_MakeExternalPtr((void *)lib,install("RapptureLib"),R_NilValue);
77    PROTECT(ptr);
78    R_RegisterCFinalizerEx(ptr, rp_lib_finalizer, TRUE);
79
80    handle = storeObject_Void((void*)lib);
81
82    INTEGER(ans)[0] = handle;
83    UNPROTECT(2);
84
85    return(ans);
86}
87
88/**********************************************************************/
89// FUNCTION: RPRLibGetString()
90/// Get data located at 'path' and return it as a string value.
91/**
92 */
93SEXP
94RPRLibGetString(
95    SEXP handle,            // integer handle of library
96    SEXP path)              // null terminated path
97{
98    RpLibrary* lib;
99    SEXP ans;
100    int handleVal = -1;
101    std::string data;
102
103    ans = allocVector(STRSXP,1);
104    PROTECT(ans);
105
106    SET_STRING_ELT(ans,0,mkChar(""));
107
108    if (!isInteger(handle) || length(handle) != 1) {
109        error("handle is not an integer");
110        UNPROTECT(1);
111        return ans;
112    }
113
114    if (!isString(path) || length(path) != 1) {
115        error("path is not a string");
116        UNPROTECT(1);
117        return ans;
118    }
119
120    handleVal = asInteger(handle);
121
122    if (handleVal == 0) {
123        error("invalid handle");
124        UNPROTECT(1);
125        return ans;
126    }
127
128    lib = (RpLibrary*) getObject_Void(handleVal);
129    if (lib == NULL) {
130        error("invalid Rappture Library Object");
131        UNPROTECT(1);
132        return ans;
133    }
134
135    data = lib->getString(CHAR(STRING_ELT(path, 0)));
136
137    SET_STRING_ELT(ans, 0, mkChar(data.c_str()));
138
139    UNPROTECT(1);
140
141    return ans;
142}
143
144
145/**********************************************************************/
146// FUNCTION: RPRLibGetDouble()
147/// Get data located at 'path' and return it as a double precision value.
148/**
149 */
150SEXP
151RPRLibGetDouble(
152    SEXP handle,            // integer handle of library
153    SEXP path)              // null terminated path
154{
155    RpLibrary* lib = NULL;
156    SEXP ans;
157    int handleVal = -1;
158    double data;
159
160    ans = allocVector(REALSXP,1);
161    PROTECT(ans);
162
163    REAL(ans)[0] = 0.0;
164
165    if (!isInteger(handle) || length(handle) != 1) {
166        error("handle is not a single integer");
167        UNPROTECT(1);
168        return ans;
169    }
170
171    if (!isString(path) || length(path) != 1) {
172        error("path is not a string");
173        UNPROTECT(1);
174        return ans;
175    }
176
177    handleVal = asInteger(handle);
178
179    if (handleVal == 0) {
180        error("invalid handle");
181        UNPROTECT(1);
182        return ans;
183    }
184
185    lib = (RpLibrary*) getObject_Void(handleVal);
186
187    if (lib == NULL) {
188        error("invalid Rappture Library Object");
189        UNPROTECT(1);
190        return ans;
191    }
192
193    data = lib->getDouble(CHAR(STRING_ELT(path, 0)));
194
195    REAL(ans)[0] = data;
196
197    UNPROTECT(1);
198
199    return ans;
200}
201
202
203/**********************************************************************/
204// FUNCTION: RPRLibInteger()
205/// Get data located at 'path' and return it as an integer value.
206/**
207 */
208SEXP
209RPRLibGetInteger(
210    SEXP handle,            // integer handle of library
211    SEXP path)              // null terminated path
212{
213    RpLibrary* lib = NULL;
214    SEXP ans;
215    int handleVal = -1;
216    int data;
217
218    ans = allocVector(INTSXP,1);
219    PROTECT(ans);
220
221    INTEGER(ans)[0] = 0;
222
223    if (!isInteger(handle) || length(handle) != 1) {
224        error("handle is not a single integer");
225        UNPROTECT(1);
226        return ans;
227    }
228
229    if (!isString(path) || length(path) != 1) {
230        error("path is not a string");
231        UNPROTECT(1);
232        return ans;
233    }
234
235    handleVal = asInteger(handle);
236
237    if (handleVal == 0) {
238        error("invalid handle");
239        UNPROTECT(1);
240        return ans;
241    }
242
243    lib = (RpLibrary*) getObject_Void(handleVal);
244
245    if (lib == NULL) {
246        error("invalid Rappture Library Object");
247        UNPROTECT(1);
248        return ans;
249    }
250
251    data = lib->getInt(CHAR(STRING_ELT(path, 0)));
252
253    INTEGER(ans)[0] = data;
254
255    UNPROTECT(1);
256
257    return ans;
258}
259
260
261/**********************************************************************/
262// FUNCTION: RPRLibGetBoolean()
263/// Get data located at 'path' and return it as an integer value.
264/**
265 */
266SEXP
267RPRLibGetBoolean(
268    SEXP handle,            // integer handle of library
269    SEXP path)              // null terminated path
270{
271    RpLibrary* lib = NULL;
272    SEXP ans;
273    int handleVal = -1;
274    bool data;
275
276    ans = allocVector(LGLSXP,1);
277    PROTECT(ans);
278
279    LOGICAL(ans)[0] = false;
280
281    if (!isInteger(handle) || length(handle) != 1) {
282        error("handle is not a single integer");
283        UNPROTECT(1);
284        return ans;
285    }
286
287    if (!isString(path) || length(path) != 1) {
288        error("path is not a string");
289        UNPROTECT(1);
290        return ans;
291    }
292
293    handleVal = asInteger(handle);
294
295    if (handleVal == 0) {
296        error("invalid handle");
297        UNPROTECT(1);
298        return ans;
299    }
300
301    lib = (RpLibrary*) getObject_Void(handleVal);
302
303    if (lib == NULL) {
304        error("invalid Rappture Library Object");
305        UNPROTECT(1);
306        return ans;
307    }
308
309    data = lib->getBool(CHAR(STRING_ELT(path, 0)));
310
311    LOGICAL(ans)[0] = data;
312
313    UNPROTECT(1);
314
315    return ans;
316}
317
318
319/**********************************************************************/
320// FUNCTION: RPRLibGetFile()
321/// Get data located at 'path' and write it to the file 'fileName'.
322/**
323 * Returns if any bytes were written to the file
324 */
325SEXP
326RPRLibGetFile (
327    SEXP handle,            // integer handle of library
328    SEXP path,              // null terminated path
329    SEXP fileName)          // name of file to write data to
330{
331    RpLibrary* lib = NULL;
332    SEXP ans;
333    int handleVal = -1;
334    int nbytes = 0;
335
336    ans = allocVector(INTSXP,1);
337    PROTECT(ans);
338
339    INTEGER(ans)[0] = -1;
340
341    if (!isInteger(handle) || length(handle) != 1) {
342        error("handle is not a single integer");
343        UNPROTECT(1);
344        return ans;
345    }
346
347    if (!isString(path) || length(path) != 1) {
348        error("path is not a string");
349        UNPROTECT(1);
350        return ans;
351    }
352
353    if (!isString(fileName) || length(fileName) != 1) {
354        error("fileName is not a string");
355        UNPROTECT(1);
356        return ans;
357    }
358
359    handleVal = asInteger(handle);
360
361    if (handleVal == 0) {
362        error("invalid handle");
363        UNPROTECT(1);
364        return ans;
365    }
366
367    lib = (RpLibrary*) getObject_Void(handleVal);
368
369    if (lib == NULL) {
370        error("invalid Rappture Library Object");
371        UNPROTECT(1);
372        return ans;
373    }
374
375    nbytes = lib->getFile(  CHAR(STRING_ELT(path, 0)),
376                            CHAR(STRING_ELT(fileName, 0)));
377
378    INTEGER(ans)[0] = nbytes;
379
380    UNPROTECT(1);
381
382    return ans;
383}
384
385
386
387/**********************************************************************/
388// FUNCTION: RPRLibPutString()
389/// Put string into Rappture Library Object at location 'path'.
390/**
391 */
392SEXP
393RPRLibPutString(
394    SEXP handle,
395    SEXP path,
396    SEXP value,
397    SEXP append)
398{
399    RpLibrary* lib = NULL;
400    SEXP ans;
401    int handleVal = -1;
402    int nbytes = 0;
403    unsigned int appendVal;
404
405    ans = allocVector(INTSXP,1);
406    PROTECT(ans);
407
408    INTEGER(ans)[0] = -1;
409
410    if (!isInteger(handle) || length(handle) != 1) {
411        error("handle is not an integer");
412        UNPROTECT(1);
413        return ans;
414    }
415
416    if (!isString(path) || length(path) != 1) {
417        error("path is not a string");
418        UNPROTECT(1);
419        return ans;
420    }
421
422    if (!isString(value) || length(value) != 1) {
423        error("value is not a string");
424        UNPROTECT(1);
425        return ans;
426    }
427
428    if (!isLogical(append) || length(append) != 1) {
429        error("append is not a logical");
430        UNPROTECT(1);
431        return ans;
432    }
433
434    handleVal = asInteger(handle);
435
436    if (handleVal == 0) {
437        error("invalid handle");
438        UNPROTECT(1);
439        return ans;
440    }
441
442    lib = (RpLibrary*) getObject_Void(handleVal);
443
444    if (lib == NULL) {
445        error("invalid Rappture Library Object");
446        UNPROTECT(1);
447        return ans;
448    }
449
450    appendVal = asLogical(append);
451    if (appendVal == 1) {
452        appendVal = RPLIB_APPEND;
453    } else if (appendVal == 0) {
454        appendVal = RPLIB_OVERWRITE;
455    } else {
456        // NA_LOGICAL was returned?
457        error("invalid append value");
458        UNPROTECT(1);
459        return ans;
460    }
461
462    lib->put(CHAR(STRING_ELT(path, 0)),
463             CHAR(STRING_ELT(value, 0)),
464             "",
465             appendVal,
466             RPLIB_TRANSLATE);
467
468
469    INTEGER(ans)[0] = 0;
470
471    UNPROTECT(1);
472
473    return ans;
474}
475
476
477/**********************************************************************/
478// FUNCTION: RPRLibPutData()
479/// Put string into Rappture Library Object at location 'path'.
480/**
481 */
482/*
483SEXP
484RPRLibPutData(
485    SEXP handle,
486    SEXP path,
487    SEXP bytes,
488    SEXP nbytes,
489    SEXP append)
490{
491    RpLibrary* lib = NULL;
492    SEXP ans;
493    int handleVal = -1;
494    int nbytes = 0;
495    unsigned int appendVal;
496
497    ans = allocVector(INTSXP,1);
498    PROTECT(ans);
499
500    INTEGER(ans)[0] = -1;
501
502    if (!isInteger(handle) || length(handle) != 1) {
503        error("handle is not an integer");
504        UNPROTECT(1);
505        return ans;
506    }
507
508    if (!isString(path) || length(path) != 1) {
509        error("path is not a string");
510        UNPROTECT(1);
511        return ans;
512    }
513
514    if (!isString(bytes) || length(bytes) != 1) {
515        error("bytes is not a string");
516        UNPROTECT(1);
517        return ans;
518    }
519
520    if (!isInteger(nbytes) || length(nbytes) != 1) {
521        error("nbytes is not an integer");
522        UNPROTECT(1);
523        return ans;
524    }
525
526    if (!isLogical(append) || length(append) != 1) {
527        error("append is not a logical");
528        UNPROTECT(1);
529        return ans;
530    }
531
532    handleVal = asInteger(handle);
533
534    if (handleVal == 0) {
535        error("invalid handle");
536        UNPROTECT(1);
537        return ans;
538    }
539
540    lib = (RpLibrary*) getObject_Void(handleVal);
541
542    if (lib == NULL) {
543        error("invalid Rappture Library Object");
544        UNPROTECT(1);
545        return ans;
546    }
547
548    if (asLogical(append)) {
549        appendVal = RPLIB_APPEND;
550    } else {
551        appendVal = RPLIB_OVERWRITE;
552    }
553
554    lib->putData(CHAR(STRING_ELT(path, 0)),
555                 CHAR(STRING_ELT(value, 0)),
556                 INTEGER(nbytes),
557                 appendVal);
558
559    INTEGER(ans)[0] = 0;
560
561    UNPROTECT(1);
562
563    return ans;
564}
565*/
566
567/**********************************************************************/
568// FUNCTION: RPRLibPutDouble()
569/// Put double value into Rappture Library Object at location 'path'.
570/**
571 */
572SEXP
573RPRLibPutDouble(
574    SEXP handle,
575    SEXP path,
576    SEXP value,
577    SEXP append)
578{
579    RpLibrary* lib = NULL;
580    SEXP ans;
581    int handleVal = -1;
582    int nbytes = 0;
583    unsigned int appendVal;
584
585    ans = allocVector(INTSXP,1);
586    PROTECT(ans);
587
588    INTEGER(ans)[0] = -1;
589
590    if (!isInteger(handle) || length(handle) != 1) {
591        error("handle is not an integer");
592        UNPROTECT(1);
593        return ans;
594    }
595
596    if (!isString(path) || length(path) != 1) {
597        error("path is not a string");
598        UNPROTECT(1);
599        return ans;
600    }
601
602    if (!isReal(value) || length(value) != 1) {
603        error("value is not a real");
604        UNPROTECT(1);
605        return ans;
606    }
607
608    if (!isLogical(append) || length(append) != 1) {
609        error("append is not a logical");
610        UNPROTECT(1);
611        return ans;
612    }
613
614    handleVal = asInteger(handle);
615
616    if (handleVal == 0) {
617        error("invalid handle");
618        UNPROTECT(1);
619        return ans;
620    }
621
622    lib = (RpLibrary*) getObject_Void(handleVal);
623
624    if (lib == NULL) {
625        error("invalid Rappture Library Object");
626        UNPROTECT(1);
627        return ans;
628    }
629
630    appendVal = asLogical(append);
631    if (appendVal == 1) {
632        appendVal = RPLIB_APPEND;
633    } else if (appendVal == 0) {
634        appendVal = RPLIB_OVERWRITE;
635    } else {
636        // NA_LOGICAL was returned?
637        error("invalid append value");
638        UNPROTECT(1);
639        return ans;
640    }
641
642    lib->put(CHAR(STRING_ELT(path, 0)),
643             asReal(value),
644             "",
645             appendVal);
646
647    INTEGER(ans)[0] = 0;
648
649    UNPROTECT(1);
650
651    return ans;
652}
653
654
655/**********************************************************************/
656// FUNCTION: RPRLibPutFile()
657/// Put double value into Rappture Library Object at location 'path'.
658/**
659 */
660SEXP
661RPRLibPutFile(
662    SEXP handle,
663    SEXP path,
664    SEXP fname,
665    SEXP compress,
666    SEXP append)
667{
668    RpLibrary* lib = NULL;
669    SEXP ans;
670    int handleVal = -1;
671    unsigned int appendVal;
672    unsigned int compressVal;
673
674    ans = allocVector(INTSXP,1);
675    PROTECT(ans);
676
677    INTEGER(ans)[0] = -1;
678
679    if (!isInteger(handle) || length(handle) != 1) {
680        error("handle is not an integer");
681        UNPROTECT(1);
682        return ans;
683    }
684
685    if (!isString(path) || length(path) != 1) {
686        error("path is not a string");
687        UNPROTECT(1);
688        return ans;
689    }
690
691    if (!isString(fname) || length(fname) != 1) {
692        error("fileName is not a string");
693        UNPROTECT(1);
694        return ans;
695    }
696
697    if (!isLogical(compress) || length(compress) != 1) {
698        error("compress is not a logical");
699        UNPROTECT(1);
700        return ans;
701    }
702
703    if (!isLogical(append) || length(append) != 1) {
704        error("append is not a logical");
705        UNPROTECT(1);
706        return ans;
707    }
708
709    handleVal = asInteger(handle);
710
711    if (handleVal == 0) {
712        error("invalid handle");
713        UNPROTECT(1);
714        return ans;
715    }
716
717    lib = (RpLibrary*) getObject_Void(handleVal);
718
719    if (lib == NULL) {
720        error("invalid Rappture Library Object");
721        UNPROTECT(1);
722        return ans;
723    }
724
725    compressVal = asLogical(compress);
726    if (compressVal == 1) {
727        compressVal = RPLIB_COMPRESS;
728    } else {
729        compressVal = RPLIB_NO_COMPRESS;
730    }
731
732    appendVal = asLogical(append);
733    if (appendVal == 1) {
734        appendVal = RPLIB_APPEND;
735    } else {
736        appendVal = RPLIB_OVERWRITE;
737    }
738
739    lib->putFile(CHAR(STRING_ELT(path, 0)),
740                 CHAR(STRING_ELT(fname,0)),
741                 compressVal,
742                 appendVal);
743
744    INTEGER(ans)[0] = 0;
745
746    UNPROTECT(1);
747
748    return ans;
749}
750
751/**********************************************************************/
752// FUNCTION: rp_result()
753/// Write xml text to a run.xml file and signal the program has completed
754/**
755 */
756SEXP
757RPRLibResult(
758    SEXP handle)
759{
760    RpLibrary* lib = NULL;
761    SEXP ans;
762    int handleVal = -1;
763
764    ans = allocVector(INTSXP,1);
765    PROTECT(ans);
766
767    INTEGER(ans)[0] = -1;
768
769    if (!isInteger(handle) || length(handle) != 1) {
770        error("handle is not an integer");
771        UNPROTECT(1);
772        return ans;
773    }
774
775    handleVal = asInteger(handle);
776
777    if (handleVal == 0) {
778        error("invalid handle");
779        UNPROTECT(1);
780        return ans;
781    }
782
783    lib = (RpLibrary*) getObject_Void(handleVal);
784
785    if (lib == NULL) {
786        error("invalid Rappture Library Object");
787        UNPROTECT(1);
788        return ans;
789    }
790
791    lib->put("tool.version.rappture.language", "R");
792    lib->result();
793
794    INTEGER(ans)[0] = 1;
795
796    UNPROTECT(1);
797
798    return ans;
799}
800
801#ifdef __cplusplus
802}
803#endif // ifdef __cplusplus
804
Note: See TracBrowser for help on using the repository browser.