Skip to content
Browse files

optimized exec cat to fcopy in reinplace

ftruncate(2) original file after performing substitutions
added ftruncate(2) command to Pextlib.c

git-svn-id: d073be05-634f-4543-b044-5fe20cf6d1d6
  • Loading branch information
Kevin Van Vechten
Kevin Van Vechten committed Oct 8, 2002
1 parent 614915e commit 68a8749148abd402e985235427efae1a16c376b5
Showing with 53 additions and 1 deletion.
  1. +47 −0 src/pextlib1.0/Pextlib.c
  2. +6 −1 src/port1.0/portutil.tcl
@@ -260,6 +260,52 @@ int FlockCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST
return TCL_OK;

/* XXX: cannot set eof > 2GB */
int FtruncateCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
int fd, ret;
long eof = 0;
char *res;
Tcl_Channel channel;
ClientData handle;

if (objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId eof");
return TCL_ERROR;

if ((channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL)) == NULL)
return TCL_ERROR;

if (Tcl_GetChannelHandle(channel, TCL_READABLE|TCL_WRITABLE, &handle) != TCL_OK) {
Tcl_SetResult(interp, "error getting channel handle", TCL_STATIC);
return TCL_ERROR;
fd = (int) handle;

if (Tcl_GetLongFromObj(interp, objv[2], &eof) != TCL_OK) {
return TCL_ERROR;

if ((ret = ftruncate(fd, eof)) != 0)
switch(errno) {
case EBADF:
res = "EBADF";
case EINVAL:
res = "EINVAL";
res = strerror(errno);
Tcl_SetResult(interp, (void *) res, TCL_STATIC);
return TCL_ERROR;
return TCL_OK;

int ReaddirCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
DIR *dirp;
@@ -344,6 +390,7 @@ int Pextlib_Init(Tcl_Interp *interp)
Tcl_CreateObjCommand(interp, "system", SystemCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "flock", FlockCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "ftruncate", FtruncateCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "readdir", ReaddirCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "strsed", StrsedCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "mkstemp", MkstempCmd, NULL, NULL);
@@ -324,13 +324,18 @@ proc reinplace {oddpattern file} {
seek $output 0
seek $input 0

if {[catch {exec cat <@$output >@$input 2>/dev/null} error]} {
# copy from strsed output back into the input
if {[catch {fcopy $output $input} error]} {
ui_error "reinplace: $error"
close $output
close $input
file delete "$tmpfile"
return -code error "reinplace failed"

set eof [file size "$tmpfile"]
puts "$tmpfile $eof"
ftruncate $input $eof

close $output
close $input

0 comments on commit 68a8749

Please sign in to comment.
You can’t perform that action at this time.