From: Benjamin Sugars Date: Wed, 2 May 2001 10:53:11 +0000 (-0400) Subject: Re: [PATCH] Allow appending on a PerlIO::Scalar X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=09bf542c87dffb276bec96e979ba5437e7fc39b1;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] Allow appending on a PerlIO::Scalar Message-ID: p4raw-id: //depot/perl@9959 --- diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index f22193e..9e9412a 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -17,6 +17,7 @@ IV PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg) { dTHX; + IV code; PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); /* If called (normally) via open() then arg is ref to scalar we are using, otherwise arg (from binmode presumably) is either NULL @@ -38,11 +39,12 @@ PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg) s->var = newSVpvn("",0); } sv_upgrade(s->var,SVt_PV); - if (strnEQ(mode,"a",1)) + code = PerlIOBase_pushed(f,mode,Nullsv); + if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) s->posn = SvCUR(SvRV(arg)); else s->posn = 0; - return PerlIOBase_pushed(f,mode,Nullsv); + return code; } IV @@ -123,9 +125,34 @@ PerlIOScalar_write(PerlIO *f, const void *vbuf, Size_t count) { if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) { - return PerlIOScalar_unread(f,vbuf,count); + dTHX; + Off_t offset; + PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); + SV *sv = s->var; + char *dst; + if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) + { + dst = SvGROW(sv,SvCUR(sv)+count); + offset = SvCUR(sv); + s->posn = offset+count; + } + else + { + if ((s->posn+count) > SvCUR(sv)) + dst = SvGROW(sv,s->posn+count); + else + dst = SvPV_nolen(sv); + offset = s->posn; + s->posn += count; + } + Move(vbuf,dst+offset,count,char); + if (s->posn > SvCUR(sv)) + SvCUR_set(sv,s->posn); + SvPOK_on(s->var); + return count; } - return 0; + else + return 0; } IV