[Rd] [Patch suggestion] Adding 3rd arg to tempfile() to set extension
Duncan Murdoch
murdoch.duncan at gmail.com
Fri Mar 18 19:41:35 CET 2011
I think this is a good idea; I'll put it into r-devel and possibly r-alpha.
Duncan Murdoch
On 18/03/2011 1:54 PM, Dirk Eddelbuettel wrote:
> The other day I was working on an example which used tempfile() to create
> file for use by the graphics device. And while I love tempfile()---as it is
> portable and clever and the files get cleaned by R and all that---I noticed
> one missing feature I would like to see: beside a starting name pattern, and
> an optional directory, an 'file extension' argument would be nice to have.
> As e.g. in
>
> tmppdf<- tempfile(fileext=".pdf")
> tmppng<- tempfile(fileext=".png")
> tmpjpeg<- tempfile(fileext=".jpeg")
>
> Below is a short and simple patch which extends tempfile() to three arguments
> with the new one (fileext) defaulting to "". If set, the extension is
> appended to what we got from R_tmpnam(). I made this non-vectorised; this
> could be changed. I left R_tmpnam() alone as its interface appears in a
> header. I updated the manual page too.
>
> I wrote this again current R-devel source from SVN, the patch reflects
> that. The patch applies cleanly to R-alpha as well where 'make check' passes
> (and I only tried this as make check had issues with R-devel but devel being
> devel I am not sure that it was this patch).
>
> Now, I understand that tempfile() is used in a large number of places so I
> more or less expect to get stone silence or a resounding "don't even think
> about it". This end can always be achieved with a local function; but maybe
> somebody else see merit in having this at the source.
>
> Thanks for listening, and for considering this.
>
> Regards, Dirk
>
> Index: src/library/base/R/temp.R
> ===================================================================
> --- src/library/base/R/temp.R (revision 54862)
> +++ src/library/base/R/temp.R (working copy)
> @@ -14,7 +14,7 @@
> # A copy of the GNU General Public License is available at
> # http://www.r-project.org/Licenses/
>
> -tempfile<- function(pattern = "file", tmpdir = tempdir())
> - .Internal(tempfile(pattern, tmpdir))
> +tempfile<- function(pattern = "file", tmpdir = tempdir(), fileext = "")
> + .Internal(tempfile(pattern, tmpdir, fileext))
>
> tempdir<- function() .Internal(tempdir())
> Index: src/library/base/man/tempfile.Rd
> ===================================================================
> --- src/library/base/man/tempfile.Rd (revision 54862)
> +++ src/library/base/man/tempfile.Rd (working copy)
> @@ -12,13 +12,14 @@
> names for temporary files.
> }
> \usage{
> -tempfile(pattern = "file", tmpdir = tempdir())
> +tempfile(pattern = "file", tmpdir = tempdir(), fileext = "")
> tempdir()
> }
> \arguments{
> \item{pattern}{a non-empty character vector giving the initial part
> of the name.}
> \item{tmpdir}{a non-empty character vector giving the directory name}
> + \item{fileext}{an optional character object giving a file extension}
> }
> \value{
> For \code{tempfile} a character vector giving the names of possible
> @@ -55,6 +56,11 @@
> contains a space in any of the components, the path returned will use
> the shortnames version of the path.
> #endif
> +
> + The optional argument \code{fileext} can be use to supply a file
> + extension. This can be useful if the temporary file is for example use
> + with a graphics device as the file type can be signalled via the
> + extension; an example would be \code{fileext=".png"}.
> }
> \references{
> Becker, R. A., Chambers, J. M. and Wilks, A. R. (1988)
> Index: src/main/names.c
> ===================================================================
> --- src/main/names.c (revision 54862)
> +++ src/main/names.c (working copy)
> @@ -786,7 +786,7 @@
> {"file.info", do_fileinfo, 0, 11, 1, {PP_FUNCALL, PREC_FN, 0}},
> {"file.access", do_fileaccess, 0, 11, 2, {PP_FUNCALL, PREC_FN, 0}},
> {"dir.create", do_dircreate, 0, 11, 4, {PP_FUNCALL, PREC_FN, 0}},
> -{"tempfile", do_tempfile, 0, 11, 2, {PP_FUNCALL, PREC_FN, 0}},
> +{"tempfile", do_tempfile, 0, 11, 3, {PP_FUNCALL, PREC_FN, 0}},
> {"tempdir", do_tempdir, 0, 11, 0, {PP_FUNCALL, PREC_FN, 0}},
> {"R.home", do_Rhome, 0, 11, 0, {PP_FUNCALL, PREC_FN, 0}},
> {"date", do_date, 0, 11, 0, {PP_FUNCALL, PREC_FN, 0}},
> Index: src/main/sysutils.c
> ===================================================================
> --- src/main/sysutils.c (revision 54862)
> +++ src/main/sysutils.c (working copy)
> @@ -233,30 +233,44 @@
>
> SEXP attribute_hidden do_tempfile(SEXP call, SEXP op, SEXP args, SEXP env)
> {
> - SEXP ans, pattern, tempdir;
> - const char *tn, *td;
> + SEXP ans, pattern, fileext, tempdir;
> + const char *tn, *td, *te;
> char *tm;
> - int i, n1, n2, slen;
> + int i, n1, n2, n3, slen;
> + char tmp1[PATH_MAX];
>
> checkArity(op, args);
> - pattern = CAR(args); n1 = length(pattern);
> - tempdir = CADR(args); n2 = length(tempdir);
> + pattern = CAR(args); n1 = length(pattern); args = CDR(args);
> + tempdir = CAR(args); n2 = length(tempdir); args = CDR(args);
> + fileext = CAR(args); n3 = length(fileext);
> if (!isString(pattern))
> error(_("invalid filename pattern"));
> if (!isString(tempdir))
> error(_("invalid '%s' value"), "tempdir");
> + if (!isString(fileext))
> + error(_("invalid pattern for end-of-filename"));
> if (n1< 1)
> error(_("no 'pattern'"));
> if (n2< 1)
> error(_("no 'tempdir'"));
> + /* fileext is optional and defaults to "" so no test for vector*/
> + if (n3 != 1)
> + error(_("only single argument for end-of-filename pattern supported"));
> slen = (n1> n2) ? n1 : n2;
> PROTECT(ans = allocVector(STRSXP, slen));
> for(i = 0; i< slen; i++) {
> tn = translateChar( STRING_ELT( pattern , i%n1 ) );
> td = translateChar( STRING_ELT( tempdir , i%n2 ) );
> + te = translateChar( STRING_ELT( fileext , 0 ) );
> /* try to get a new file name */
> tm = R_tmpnam(tn, td);
> - SET_STRING_ELT(ans, i, mkChar(tm));
> + if (0 != strlen(te)) {
> + /* append optional extension, or null string */
> + snprintf(tmp1, PATH_MAX, "%s%s", tm, te);
> + SET_STRING_ELT(ans, i, mkChar(tmp1));
> + } else {
> + SET_STRING_ELT(ans, i, mkChar(tm));
> + }
> if(tm) free(tm);
> }
> UNPROTECT(1);
>
More information about the R-devel
mailing list