1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
IMPORTER <- ".__rjava__import"
java_class_importers <- new.env()
assign( ".namespaces", NULL, envir = java_class_importers )
getImporterFromNamespace <- function( nm, create = TRUE ){
.namespaces <- get(".namespaces", envir = java_class_importers )
if( !is.null( .namespaces ) ){
for( item in .namespaces ){
if( identical( item$nm, nm ) ){
return( item$importer )
}
}
}
if( create ){
addImporterNamespace(nm)
}
}
addImporterNamespace <- function( nm ){
importer <- .jnew( "RJavaImport", .jcast( .rJava.class.loader, "java/lang/ClassLoader" ) )
assign( ".namespaces",
append( list( list( nm = nm, importer = importer ) ), get(".namespaces", envir = java_class_importers ) ),
envir = java_class_importers )
importer
}
getImporterFromEnvironment <- function(env, create = TRUE){
if( isNamespace( env ) ){
getImporterFromNamespace( env )
} else if( exists(IMPORTER, envir = env ) ){
get( IMPORTER, envir = env )
} else if( create ){
addImporterNamespace(env)
}
}
getImporterFromGlobalEnv <- function( ){
if( exists( "global", envir = java_class_importers ) ){
get( "global", envir = java_class_importers )
} else{
initGlobalEnvImporter()
}
}
initGlobalEnvImporter <- function(){
importer <- .jnew( "RJavaImport", .jcast( .rJava.class.loader, "java/lang/ClassLoader" ) )
assign( "global", importer , envir = java_class_importers )
importer
}
import <- function( package = "java.util", env = sys.frame(sys.parent()) ){
if( missing(env) ){
caller <- sys.function(-1)
env <- environment( caller )
if( isNamespace( env ) ){
importer <- getImporterFromNamespace( env )
}
} else{
force(env)
if( !is.environment( env ) ){
stop( "env is not an environment" )
}
if( ! exists( IMPORTER, env ) || is.jnull( get( IMPORTER, envir = env ) ) ){
importer <- .jnew( "RJavaImport", .jcast( .rJava.class.loader, "java/lang/ClassLoader" ) )
if( isNamespace(env) ){
unlockBinding( IMPORTER, env = env )
assignInNamespace( IMPORTER, importer, envir = env )
}
assign( IMPORTER, importer, envir = env )
} else{
importer <- get( IMPORTER, envir = env )
}
}
mustbe.importer( importer )
.jcall( importer, "V", "importPackage", package )
}
is.importer <- function(x){
is( x, "jobjRef" ) && .jinherits( x, "RJavaImport" )
}
mustbe.importer <- function(x){
if( !is.importer(x) ){
stop( "object not a suitable java package importer" )
}
}
#' collect importers
getAvailableImporters <- function( frames = TRUE, namespace = TRUE,
global = TRUE, caller = sys.function(-1L) ){
importers <- .jnew( "java/util/HashSet" )
addImporter <- function( importer ){
if( is.importer( importer ) ){
.jcall( importers, "Z", "add", .jcast(importer) )
}
}
if( isTRUE( global ) ){
addImporter( getImporterFromGlobalEnv() )
}
if( isTRUE( frames ) ){
frames <- sys.frames()
if( length(frames) > 1L ){
sapply( head( frames, -1L ), function(env) {
if( !identical( env, .GlobalEnv ) ){
addImporter( getImporterFromEnvironment( env ) )
}
} )
}
}
if( isTRUE( namespace ) ){
force(caller)
env <- environment( caller )
if( isNamespace( env ) ){
addImporter( getImporterFromNamespace( env ) )
}
}
importers
}
#' lookup for a class name in the available importers
lookup <- function( name = "Object", ..., caller = sys.function(-1L) ){
force(caller)
importers <- getAvailableImporters(..., caller = caller)
.jcall( "RJavaImport", "Ljava/lang/Class;", "lookup",
name, .jcast( importers, "java/util/Set" ) )
}
javaImport <- function( packages = "java.lang" ){
importer <- .jnew( "RJavaImport", .jcast( .rJava.class.loader, "java/lang/ClassLoader" ) )
.jcall( importer, "V", "importPackage", packages )
.Call( "newRJavaLookupTable" , importer,
PACKAGE = "rJava" )
}
|
