You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1999/05/18 04:08:34 UTC

cvs commit: modperl/t/net/perl/io perlio.pl

dougm       99/05/17 19:08:34

  Modified:    .        Changes
               src/modules/perl perlio.c
               t/net/perl/io perlio.pl
  Log:
  get rid of odd WRITE message in perlio.pl test if $Config{usesfio}
  
  fix possible overwrite in perlio.c:sfapacheread() #ifdef USE_SFIO
  
  Revision  Changes    Path
  1.289     +6 -0      modperl/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /export/home/cvs/modperl/Changes,v
  retrieving revision 1.288
  retrieving revision 1.289
  diff -u -r1.288 -r1.289
  --- Changes	1999/05/18 01:44:59	1.288
  +++ Changes	1999/05/18 02:08:31	1.289
  @@ -8,6 +8,12 @@
   
   =item 1.19_01-dev
   
  +get rid of odd WRITE message in perlio.pl test if $Config{usesfio}
  +[John Hughes <jo...@calva.com>]
  +
  +fix possible overwrite in perlio.c:sfapacheread() #ifdef USE_SFIO
  +[John Hughes <jo...@calva.com>]
  +
   dont use DEFAULT_PATH if r->subprocess_env->{PATH} is already set
   [Bertrand Demiddelaer <wi...@hotmail.com>]
   
  
  
  
  1.5       +22 -9     modperl/src/modules/perl/perlio.c
  
  Index: perlio.c
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/perlio.c,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- perlio.c	1998/06/03 15:53:22	1.4
  +++ perlio.c	1999/05/18 02:08:33	1.5
  @@ -96,7 +96,7 @@
   
   static int sfapachewrite(f, buffer, n, disc)
       Sfio_t* f;      /* stream involved */
  -    char*           buffer;    /* buffer to read into */
  +    char*           buffer;    /* buffer to write from */
       int             n;      /* number of bytes to send */
       Sfdisc_t*       disc;   /* discipline */        
   {
  @@ -123,8 +123,7 @@
   {
       dSP;
       int count;
  -    long nrd;
  -    char *tmpbuf;
  +    int nrd;
       SV *sv = sv_newmortal();
       request_rec *r = ((Apache_t*)disc)->r;
       MP_TRACE_g(fprintf(stderr, "sfapacheread: want %d bytes\n", bufsiz)); 
  @@ -134,14 +133,28 @@
       XPUSHs(sv);
       XPUSHs(sv_2mortal(newSViv(bufsiz)));
       PUTBACK;
  -    perl_call_pv("Apache::read", G_SCALAR|G_EVAL);
  -    tmpbuf = (char *)pstrdup(r->pool, SvPV(sv,na));
  -    memcpy(buffer, tmpbuf, SvLEN(sv));
  +    count = perl_call_pv("Apache::read", G_SCALAR|G_EVAL);
       SPAGAIN;
  -    if(count == 1) 
  -	nrd = POPl;
  +    if (SvTRUE(ERRSV)) {
  +	fprintf (stderr, "Apache::read died %s\n", SvPV(ERRSV, na));
  +	nrd = -1;
  +	POPs;
  +    }
  +    else {
  +        char *tmpbuf = SvPV(sv, nrd);
  +        if(count == 1) {
  +	    nrd = POPi;
  +	}
  +	MP_TRACE_g(fprintf(stderr, "sfapacheread: got %d \"%.*s\"\n",
  +			   nrd, nrd > 40 ? 40 : nrd, tmpbuf));
  +        if (nrd > bufsiz) {
  +	    abort();
  +	}
  +	memcpy(buffer, tmpbuf, nrd);
  +    }
  +    PUTBACK;
       FREETMPS;LEAVE;
  -    return bufsiz;
  +    return nrd;
   }
   
   Sfdisc_t * sfdcnewapache(request_rec *r)
  
  
  
  1.5       +4 -2      modperl/t/net/perl/io/perlio.pl
  
  Index: perlio.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/io/perlio.pl,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- perlio.pl	1998/09/01 22:30:19	1.4
  +++ perlio.pl	1999/05/18 02:08:33	1.5
  @@ -1,5 +1,7 @@
   #!/user/local/bin/perl
   
  +use Config;
  +
   #we're in Apache::Registry
   #our perl is configured use sfio so we can 
   #print() to STDOUT
  @@ -25,10 +27,10 @@
       print "perlio test...\n";
       print "\$^X is $^X\n" if $^X;
   
  -    if($] >= 5.005) {
  +    if($] >= 5.005 && $Config{usesfio} ne "true") {
   	my $msg = "1234WRITEmethod";
   	syswrite STDOUT, $msg, 5, 4;
  -	print " to STDOUT works with $]\n";
  +	print " to STDOUT works with $] without sfio\n";
       }
   
       my $loc = $r->location;