SCM

SCM Repository

[tm] Diff of /pkg/R/source.R
ViewVC logotype

Diff of /pkg/R/source.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1404, Tue Feb 17 18:04:22 2015 UTC revision 1407, Mon Feb 23 20:38:08 2015 UTC
# Line 3  Line 3 
3    
4  getSources <-  getSources <-
5  function()  function()
6     c("DataframeSource", "DirSource", "URISource", "VectorSource", "XMLSource")     c("DataframeSource", "DirSource", "URISource", "VectorSource", "XMLSource",
7         "ZipSource")
8    
9  SimpleSource <-  SimpleSource <-
10  function(encoding = "",  function(encoding = "",
# Line 87  Line 88 
88                   uri = x, class = "XMLSource")                   uri = x, class = "XMLSource")
89  }  }
90    
91    # A ZIP file with its compressed files interpreted as documents
92    ZipSource <-
93    function(zipfile, pattern = NULL, recursive = FALSE, ignore.case = FALSE,
94             mode = "text")
95    {
96        if (!identical(mode, "text") &&
97            !identical(mode, "binary") &&
98            !identical(mode, ""))
99            stop(sprintf("invalid mode '%s'", mode))
100    
101        SimpleSource(exdir = NULL,
102                     files = NULL,
103                     mode = mode,
104                     pattern = pattern,
105                     recursive = recursive,
106                     ignore.case = ignore.case,
107                     zipfile = zipfile,
108                     class = "ZipSource")
109    }
110    
111  # tau:::read_all_bytes  # tau:::read_all_bytes
112  read_all_bytes <-  read_all_bytes <-
113  function(con, chunksize = 2 ^ 16)  function(con, chunksize = 2 ^ 16)
# Line 127  Line 148 
148  close.SimpleSource <-  close.SimpleSource <-
149  function(con, ...)  function(con, ...)
150      con      con
151    open.ZipSource <-
152    function(x)
153    {
154        exdir <- tempfile("ZipSource")
155        dir.create(exdir, mode = "0700")
156    
157        destfile <- x$zipfile
158    
159        if (!file.exists(destfile)) {
160            destfile <- tempfile()
161            download.file(x$zipfile, destfile)
162            on.exit(file.remove(destfile))
163        }
164    
165        files <- unzip(destfile, list = TRUE)
166        ## Directories have length 0
167        files <- files[files$Length > 0, "Name"]
168        ## Idea: Subdirectories contain file separators
169        if (!x$recursive)
170            files <- files[!grepl(.Platform$file.sep, files, fixed = TRUE)]
171        ## Idea: pattern and ignore.case refer to the file name (like basename)
172        ## Cf. also ?dir
173        if (!is.null(x$pattern))
174            files <- files[grepl(x$pattern, files, ignore.case = x$ignore.case)]
175    
176        unzip(destfile, files, exdir = exdir)
177    
178        x$exdir <- exdir
179        x$files <- files
180        x$length <- length(files)
181        x
182    }
183    
184    close.ZipSource <-
185    function(x)
186    {
187        if (!is.null(x$exdir)) {
188            unlink(x$exdir, recursive = TRUE)
189            x$exdir <- NULL
190            x$files <- NULL
191            x$length <- 0
192        }
193        x
194    }
195    
196  eoi <-  eoi <-
197  function(x)  function(x)
# Line 147  Line 212 
212  {  {
213      filename <- x$filelist[x$position]      filename <- x$filelist[x$position]
214      list(content = readContent(filename, x$encoding, x$mode),      list(content = readContent(filename, x$encoding, x$mode),
215           uri = sprintf("file://%s", filename))           uri = paste0("file://", filename))
216  }  }
217  getElem.URISource <-  getElem.URISource <-
218  function(x)  function(x)
# Line 161  Line 226 
226  function(x)  function(x)
227      list(content = XML::saveXML(x$content[[x$position]]),      list(content = XML::saveXML(x$content[[x$position]]),
228           uri = x$uri)           uri = x$uri)
229    getElem.ZipSource <-
230    function(x)
231    {
232           path <- file.path(x$exdir, x$files[x$position])
233           list(content = readContent(path, x$encoding, x$mode),
234                uri = paste0("file://", path))
235    }
236    
237    
238  length.SimpleSource <-  length.SimpleSource <-
239  function(x)  function(x)
# Line 178  Line 251 
251  function(x)  function(x)
252      lapply(x$filelist,      lapply(x$filelist,
253             function(f) list(content = readContent(f, x$encoding, x$mode),             function(f) list(content = readContent(f, x$encoding, x$mode),
254                              uri = sprintf("file://%s", f)))                              uri = paste0("file://", f)))
255  pGetElem.URISource <-  pGetElem.URISource <-
256  function(x)  function(x)
257      lapply(x$uri,      lapply(x$uri,
# Line 189  Line 262 
262      lapply(x$content,      lapply(x$content,
263             function(y) list(content = y,             function(y) list(content = y,
264                              uri = NULL))                              uri = NULL))
265    pGetElem.ZipSource <-
266    function(x)
267        lapply(file.path(x$exdir, x$files),
268               function(f) list(content = readContent(f, x$encoding, x$mode),
269                                uri = paste0("file://", f))
270    
271  reader <-  reader <-
272  function(x)  function(x)

Legend:
Removed from v.1404  
changed lines
  Added in v.1407

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge