1
###########################################################################/**
2
# @RdocClass RspShSourceCodeFactory
3
#
4
# @title "The RspShSourceCodeFactory class"
5
#
6
# \description{
7
#  @classhierarchy
8
#
9
#  An RspShSourceCodeFactory is an @see "RspSourceCodeFactory" for
10
#  the shell ('sh') script language.
11
# }
12
#
13
# @synopsis
14
#
15
# \arguments{
16
#   \item{...}{Not used.}
17
# }
18
#
19
# \section{Fields and Methods}{
20
#  @allmethods
21
# }
22
#
23
# @author
24
#
25
# @keyword internal
26
#*/###########################################################################
27
setConstructorS3("RspShSourceCodeFactory", function(...) {
28 1
  extend(RspSourceCodeFactory("sh"), "RspShSourceCodeFactory")
29
})
30

31

32

33
setMethodS3("exprToCode", "RspShSourceCodeFactory", function(object, expr, ..., index=NA) {
34
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
35
  # Local function
36
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
37 0
  escapeRspText <- function(text) {
38 0
    text <- deparse(text)
39 0
    text <- substring(text, first=2L, last=nchar(text)-1L)
40
    ## SHELL: Escape backticks
41 0
    text <- sapply(text, FUN=function(s) {
42 0
      gsub("`", "\\`", s, fixed = TRUE)
43
    })
44
    ## SHELL: Escape dollar signs
45 0
    text <- sapply(text, FUN=function(s) {
46 0
      gsub("$", "\\$", s, fixed = TRUE)
47
    })
48 0
    text
49 0
  } # escapeRspText()
50

51 0
  makeCode <- function(code, echo=FALSE, include=FALSE, ...) {
52 0
    code <- unlist(strsplit(code, split="\n", fixed=TRUE), use.names=FALSE)
53 0
    codeT <- trim(code)
54

55 0
    n <- length(code)
56 0
    codeE <- sapply(code, FUN=escapeRspText)
57 0
    codeE <- sprintf("printf \"%s\"", codeE)
58 0
    suffixR <- rep(" 2> /dev/null", times=n)
59 0
    codeR <- sprintf("%s%s", codeT, suffixR)
60 0
    if (include) {
61
      # Output the last out
62 0
      codeR[n] <- sprintf("printf \"%s\"", code[n])
63
    }
64

65 0
    codeS <- matrix(c(codeE, codeR), nrow=2L, byrow=TRUE)
66 0
    rownames(codeS) <- c("echo", "include")
67

68 0
    if (echo && !include) {
69 0
      code <- codeS[1L,,drop=TRUE]
70 0
    } else if (echo && include) {
71 0
      code <- codeS
72 0
    } else if (!echo && include) {
73 0
      code <- codeS[2L,,drop=TRUE]
74 0
    } else if (!echo && !include) {
75 0
      code <- codeS[2L,,drop=TRUE]
76
    }
77

78 0
    code
79 0
  } # makeCode()
80

81

82
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
83
  # Validate arguments
84
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
85
  # Argument 'expr':
86 0
  reqClasses <- c("RspText", "RspExpression")
87 0
  if (!inherits(expr, reqClasses)) {
88 0
    throw("Argument 'expr' must be of class RspText or RspExpression: ", class(expr)[1L])
89
  }
90

91

92
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
93
  # RspText => echo "<text>"
94
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
95 0
  if (inherits(expr, "RspText")) {
96 0
    text <- getContent(expr)
97

98 0
    code <- NULL
99 0
    while (nchar(text) > 0L) {
100 0
      textT <- substring(text, first=1L, last=1024L)
101 0
      textT <- escapeRspText(textT)
102 0
      codeT <- sprintf("printf \"%s\"", textT)
103 0
      code <- c(code, codeT)
104 0
      text <- substring(text, first=1025L)
105
    }
106 0
    if (is.null(code)) {
107 0
      code <- "printf \"\\n\""
108
    }
109

110 0
    return(code)
111
  }
112

113

114
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
115
  # RspCodeChunk => ...
116
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
117 0
  if (inherits(expr, "RspCodeChunk")) {
118 0
    code <- makeCode(getCode(expr), echo=getEcho(expr), include=getInclude(expr))
119 0
    return(code)
120
  }
121

122
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123
  # RspCode => <code>
124
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
125 0
  if (inherits(expr, "RspCode")) {
126 0
    code <- makeCode(getCode(expr), echo=getEcho(expr), include=FALSE)
127 0
    return(code)
128
  }
129

130

131
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
132
  # RspComment => [void]
133
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
134 0
  if (inherits(expr, "RspComment")) {
135 0
    return("")
136
  }
137

138

139 0
  throw(sprintf("Unknown class of RSP expression (#%d): %s", index, class(expr)[1L]))
140
}, protected=TRUE) # exprToCode()

Read our documentation on viewing source code .

Loading