ext/ + -Wall

[perl5.git] / ext / PerlIO / Scalar / Scalar.xs

diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs
index b4479d5..9f991dd 100644 (file)
--- 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,8 +39,14 @@ PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg)
    s->var = newSVpvn("",0);
   }
  sv_upgrade(s->var,SVt_PV);
- s->posn = 0;
- return PerlIOBase_pushed(f,mode,Nullsv);
+ code = PerlIOBase_pushed(f,mode,Nullsv);
+ if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
+   s->posn = SvCUR(SvRV(arg));
+ else
+   s->posn = 0;
+ if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
+   SvCUR(SvRV(arg)) = 0;
+ return code;
 }
 
 IV
@@ -58,9 +65,7 @@ PerlIOScalar_popped(PerlIO *f)
 IV
 PerlIOScalar_close(PerlIO *f)
 {
- dTHX;
  IV code = PerlIOBase_close(f);
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
  return code;
 }
@@ -108,7 +113,7 @@ PerlIOScalar_unread(PerlIO *f, const void *vbuf, Size_t count)
  dTHX;
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  char *dst = SvGROW(s->var,s->posn+count);
- Move(vbuf,dst,count,char);
+ Move(vbuf,dst+s->posn,count,char);
  s->posn += count;
  SvCUR_set(s->var,s->posn);
  SvPOK_on(s->var);
@@ -120,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
@@ -166,7 +196,10 @@ PerlIOScalar_get_cnt(PerlIO *f)
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
    PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
-   return SvCUR(s->var) - s->posn;
+   if (SvCUR(s->var) > s->posn)
+    return SvCUR(s->var) - s->posn;
+   else
+    return 0;
   }
  return 0;
 }
@@ -238,6 +271,8 @@ PerlIO_funcs PerlIO_scalar = {
 
 MODULE = PerlIO::Scalar        PACKAGE = PerlIO::Scalar
 
+PROTOTYPES: ENABLE
+
 BOOT:
 {
 #ifdef PERLIO_LAYERS