R devel - Mar 2011 - [Patch suggestion] Adding 3rd arg to tempfile() to set extension

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);

-- 
Dirk Eddelbuettel | edd at debian.org | http://dirk.eddelbuettel.com

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);
>