Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!mcsun!ukc!stl!robobar!ronald
From: ronald@robobar.co.uk (Ronald S H Khoo)
Newsgroups: comp.lang.perl
Subject: Re: fwrite?
Message-ID: <1991Jan7.170059.14593@robobar.co.uk>
Date: 7 Jan 91 17:00:59 GMT
References: <1991Jan7.144029.12478@robobar.co.uk>
Organization: Robobar Ltd., Perivale, Middx., ENGLAND.
Lines: 125

I wrote:

> Hasn't anyone ever felt the need for an fwrite interface ?

Well, I think I do.  But I don't know perl internals at all, so I don't
know if this is a reasonable way to implement it.  Whether or not I really
need it, can someone tell me if this is reasonable ?

*** arg.h~	Wed Nov 14 11:31:36 1990
--- arg.h	Mon Jan  7 15:59:12 1991
***************
*** 315,321 ****
  #define O_FTCTIME 265
  #define O_WAITPID 266
  #define O_ALARM 267
! #define MAXO 268
  
  #ifndef DOINIT
  extern char *opname[];
--- 315,322 ----
  #define O_FTCTIME 265
  #define O_WAITPID 266
  #define O_ALARM 267
! #define O_FWRITE 268
! #define MAXO 269
  
  #ifndef DOINIT
  extern char *opname[];
***************
*** 589,594 ****
--- 590,596 ----
      "FTCTIME",
      "WAITPID",
      "ALARM",
+     "FWRITE",
      "268"
  };
  #endif
***************
*** 988,993 ****
--- 990,996 ----
  	A(1,0,0),	/* FTCTIME */
  	A(1,1,0),	/* WAITPID */
  	A(1,0,0),	/* ALARM */
+ 	A(1,1,3),	/* FWRITE */
  	0
  };
  #undef A
*** eval.c~	Wed Nov 14 11:31:51 1990
--- eval.c	Mon Jan  7 16:28:10 1991
***************
*** 1061,1066 ****
--- 1061,1067 ----
  	st[2]->str_ptr[anum+maxarg] = '\0';
  	value = (double)anum;
  	goto donumset;
+     case O_FWRITE:
      case O_SYSWRITE:
      case O_SEND:
  	if ((arg[1].arg_type & A_MASK) == A_WORD)
***************
*** 1077,1082 ****
--- 1078,1085 ----
  	    if (dowarn) {
  		if (optype == O_SYSWRITE)
  		    warn("Syswrite on closed filehandle");
+ 		else if (optype == O_FWRITE)
+ 		    warn("Fwrite on closed filehandle");
  		else
  		    warn("Send on closed socket");
  	    }
***************
*** 1089,1094 ****
--- 1092,1106 ----
  	    else
  		optype = 0;
  	    anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
+ 	}
+ 	else if (optype == O_FWRITE) {
+ 	    if (maxarg > 4)
+ 		warn("Too many args on fwrite");
+ 	    if (maxarg == 4)
+ 		optype = (int)str_gnum(st[4]);
+ 	    else
+ 		optype = 0;
+ 	    anum = fwrite(tmps+optype, 1, anum, stab_io(stab)->ifp);
  	}
  #ifdef SOCKET
  	else if (maxarg >= 4) {
*** toke.c~	Wed Nov 14 11:32:19 1990
--- toke.c	Mon Jan  7 14:57:09 1991
***************
*** 819,824 ****
--- 819,826 ----
  	    FOP(O_FILENO);
  	if (strEQ(d,"flock"))
  	    FOP2(O_FLOCK);
+ 	if (strEQ(d,"fwrite"))
+ 	    FOP3(O_FWRITE);
  	break;
      case 'g': case 'G':
  	SNARFWORD;
*** t/op.fwrite~	Mon Jan  7 16:26:44 1991
--- t/op.fwrite	Mon Jan  7 16:26:07 1991
***************
*** 0 ****
--- 1,16 ----
+ print "1..4\n";
+ 
+ $file = "fwrite.$$";
+ 
+ open(FOO,'+>$file') || die "Can't write to $file";
+ 
+ $string = "Hello World\n";
+ $ret = fwrite(FOO, $string, 12);
+ print ($ret == 12 ? "ok 1\n" : "not ok 1\n");
+ $ret = seek(FOO, 0, 0);
+ print ($ret == 1 ? "ok 2\n" : "not ok 2\n");
+ $got = read(FOO,$buf,12);
+ print ($got == 12 ? "ok 3\n" : "not ok 3\n");
+ print ($buf eq $string ? "ok 4\n" : "not ok 4\n");
+ 
+ unlink $file;
-- 
ronald@robobar.co.uk +44 81 991 1142 (O) +44 71 229 7741 (H)