1.onLoad <- function(libname, pkgname) {
2  ## By default, configure udunits with path set (presumably) by the
3  ## user through the UDUNITS2_XML_PATH environment variable
4  .C('R_ut_init', as.integer(0))
5  if (!ud.have.unit.system()) {
6    ## Failing that, override it with the in-package XML file
7    p0 <- system.file("share/udunits2.xml", package="udunits2")
8    Sys.setenv(UDUNITS2_XML_PATH=p0)
9    .C('R_ut_init', as.integer(1))
10    ## If *that* fails, give the user some instructions for how to remedy
11    ## the problem
12    if (!ud.have.unit.system()) {
13      warning(
14	  "Failed to read udunits system database: udunits2 will not work properly.\nPlease set the UDUNITS2_XML_PATH environment variable before attempting to load the package")
15    }
16  }
17}
18
19.onAttach <- function(libname, pkgname) {
20    msg <- "udunits system database read"
21    p0 <- Sys.getenv("UDUNITS2_XML_PATH")
22    if (p0 != "") {
23        msg <- paste(msg, "from", p0)
24    }
25    packageStartupMessage(msg)
26}
27
28ud.are.convertible <-
29function(u1, u2) {
30  if (! (ud.is.parseable(u1) && ud.is.parseable(u2))) {
31    return(FALSE)
32  }
33  rv <- .C('R_ut_are_convertible',
34           as.character(u1),
35           as.character(u2),
36           convertible=logical(1))
37  return(rv$convertible)
38}
39
40ud.convert <-
41function(x, u1, u2) {
42  if (! ud.are.convertible(u1, u2)) {
43    stop(paste("Units", u1, "and", u2, "are not convertible"))
44  }
45  ## Filter out NA's before passing them to the C function
46  ## since it can't handle them
47  rv <- rep(NA, length(x))
48  i <- which(! is.na(x))
49
50  len <- length(i)
51  c.rv <- .C('R_ut_convert',
52           as.double(x)[i],
53           as.integer(len),
54           as.character(u1),
55           as.character(u2),
56           converted=double(len)
57           )
58  rv[i] <- c.rv$converted
59  ## If it's a matrix/vector or anything else, convert it back to it's original type
60  attributes(rv) <- attributes(x)
61  return(rv)
62}
63
64ud.get.name <-
65function(unit.string) {
66  stopifnot(ud.is.parseable(unit.string))
67  rv <- .C('R_ut_get_name',
68           as.character(unit.string),
69           ud.name=character(length=1))
70  return(rv$ud.name)
71}
72
73ud.get.symbol <-
74function(unit.string) {
75  stopifnot(ud.is.parseable(unit.string))
76  rv <- .C('R_ut_get_symbol',
77           as.character(unit.string),
78           ud.symbol=character(length=1))
79  return(rv$ud.symbol)
80}
81
82ud.is.parseable <-
83function(unit.string) {
84  rv <- .C('R_ut_is_parseable',
85           as.character(unit.string),
86           parseable=logical(1))
87  return(rv$parseable)
88}
89
90ud.set.encoding <-
91function(enc.string) {
92  .C('R_ut_set_encoding',
93     as.character(enc.string))
94  return()
95}
96
97ud.have.unit.system <-
98function() {
99  rv <- .C('R_ut_has_system',
100           exists=logical(1))
101  return(rv$exists)
102}
103