1			/*
     2			 * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the
     3			 * contents of scalar.xs. Do not edit this file, edit scalar.xs instead.
     4			 *
     5			 *	ANY CHANGES MADE HERE WILL BE LOST! 
     6			 *
     7			 */
     8			
     9			#line 1 "scalar.xs"
    10			#define PERL_NO_GET_CONTEXT
    11			#include "EXTERN.h"
    12			#include "perl.h"
    13			#include "XSUB.h"
    14			#ifdef PERLIO_LAYERS
    15			
    16			#include "perliol.h"
    17			
    18			typedef struct {
    19			    struct _PerlIO base;	/* Base "class" info */
    20			    SV *var;
    21			    Off_t posn;
    22			} PerlIOScalar;
    23			
    24			IV
    25			PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
    26					    PerlIO_funcs * tab)
    27			{
    28			    IV code;
    29			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    30			    /* If called (normally) via open() then arg is ref to scalar we are
    31			     * using, otherwise arg (from binmode presumably) is either NULL
    32			     * or the _name_ of the scalar
    33			     */
    34			    if (arg) {
    35				if (SvROK(arg)) {
    36				    s->var = SvREFCNT_inc(SvRV(arg));
    37				    if (!SvPOK(s->var) && SvTYPE(SvRV(arg)) > SVt_NULL)
    38					(void)SvPV_nolen(s->var);
    39				}
    40				else {
    41				    s->var =
    42					SvREFCNT_inc(perl_get_sv
    43						     (SvPV_nolen(arg), GV_ADD | GV_ADDMULTI));
    44				}
    45			    }
    46			    else {
    47				s->var = newSVpvn("", 0);
    48			    }
    49			    SvUPGRADE(s->var, SVt_PV);
    50			    code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
    51			    if (!SvOK(s->var) || (PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
    52				SvCUR_set(s->var, 0);
    53			    if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
    54				s->posn = SvCUR(s->var);
    55			    else
    56				s->posn = 0;
    57			    return code;
    58			}
    59			
    60			IV
    61			PerlIOScalar_popped(pTHX_ PerlIO * f)
    62			{
    63			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    64			    if (s->var) {
    65				SvREFCNT_dec(s->var);
    66				s->var = Nullsv;
    67			    }
    68			    return 0;
    69			}
    70			
    71			IV
    72			PerlIOScalar_close(pTHX_ PerlIO * f)
    73			{
    74			    IV code = PerlIOBase_close(aTHX_ f);
    75			    PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
    76			    return code;
    77			}
    78			
    79			IV
    80			PerlIOScalar_fileno(pTHX_ PerlIO * f)
    81			{
    82			    return -1;
    83			}
    84			
    85			IV
    86			PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
    87			{
    88			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    89			    switch (whence) {
    90			    case 0:
    91				s->posn = offset;
    92				break;
    93			    case 1:
    94				s->posn = offset + s->posn;
    95				break;
    96			    case 2:
    97				s->posn = offset + SvCUR(s->var);
    98				break;
    99			    }
   100			    if ((STRLEN) s->posn > SvCUR(s->var)) {
   101				(void) SvGROW(s->var, (STRLEN) s->posn);
   102			    }
   103			    return 0;
   104			}
   105			
   106			Off_t
   107			PerlIOScalar_tell(pTHX_ PerlIO * f)
   108			{
   109			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   110			    return s->posn;
   111			}
   112			
   113			SSize_t
   114			PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
   115			{
   116			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   117			    char *dst = SvGROW(s->var, (STRLEN)s->posn + count);
   118			    s->posn -= count;
   119			    Move(vbuf, dst + s->posn, count, char);
   120			    SvPOK_on(s->var);
   121			    return count;
   122			}
   123			
   124			SSize_t
   125			PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
   126			{
   127			    if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
   128				Off_t offset;
   129				PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   130				SV *sv = s->var;
   131				char *dst;
   132				if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
   133				    dst = SvGROW(sv, SvCUR(sv) + count);
   134				    offset = SvCUR(sv);
   135				    s->posn = offset + count;
   136				}
   137				else {
   138				    if ((s->posn + count) > SvCUR(sv))
   139					dst = SvGROW(sv, (STRLEN)s->posn + count);
   140				    else
   141					dst = SvPV_nolen(sv);
   142				    offset = s->posn;
   143				    s->posn += count;
   144				}
   145				Move(vbuf, dst + offset, count, char);
   146				if ((STRLEN) s->posn > SvCUR(sv))
   147				    SvCUR_set(sv, (STRLEN)s->posn);
   148				SvPOK_on(s->var);
   149				return count;
   150			    }
   151			    else
   152				return 0;
   153			}
   154			
   155			IV
   156			PerlIOScalar_fill(pTHX_ PerlIO * f)
   157			{
   158			    return -1;
   159			}
   160			
   161			IV
   162			PerlIOScalar_flush(pTHX_ PerlIO * f)
   163			{
   164			    return 0;
   165			}
   166			
   167			STDCHAR *
   168			PerlIOScalar_get_base(pTHX_ PerlIO * f)
   169			{
   170			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   171			    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   172				return (STDCHAR *) SvPV_nolen(s->var);
   173			    }
   174			    return (STDCHAR *) Nullch;
   175			}
   176			
   177			STDCHAR *
   178			PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
   179			{
   180			    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   181				PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   182				return PerlIOScalar_get_base(aTHX_ f) + s->posn;
   183			    }
   184			    return (STDCHAR *) Nullch;
   185			}
   186			
   187			SSize_t
   188			PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
   189			{
   190			    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   191				PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   192				if (SvCUR(s->var) > (STRLEN) s->posn)
   193				    return SvCUR(s->var) - (STRLEN)s->posn;
   194				else
   195				    return 0;
   196			    }
   197			    return 0;
   198			}
   199			
   200			Size_t
   201			PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
   202			{
   203			    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   204				PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   205				return SvCUR(s->var);
   206			    }
   207			    return 0;
   208			}
   209			
   210			void
   211			PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
   212			{
   213			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   214			    s->posn = SvCUR(s->var) - cnt;
   215			}
   216			
   217			PerlIO *
   218			PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
   219					  const char *mode, int fd, int imode, int perm,
   220					  PerlIO * f, int narg, SV ** args)
   221			{
   222			    SV *arg = (narg > 0) ? *args : PerlIOArg;
   223			    if (SvROK(arg) || SvPOK(arg)) {
   224				if (!f) {
   225				    f = PerlIO_allocate(aTHX);
   226				}
   227				if ( (f = PerlIO_push(aTHX_ f, self, mode, arg)) ) {
   228				    PerlIOBase(f)->flags |= PERLIO_F_OPEN;
   229				}
   230				return f;
   231			    }
   232			    return NULL;
   233			}
   234			
   235			SV *
   236			PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
   237			{
   238			    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
   239			    SV *var = s->var;
   240			    if (flags & PERLIO_DUP_CLONE)
   241				var = PerlIO_sv_dup(aTHX_ var, param);
   242			    else if (flags & PERLIO_DUP_FD) {
   243				/* Equivalent (guesses NI-S) of dup() is to create a new scalar */
   244				var = newSVsv(var);
   245			    }
   246			    else {
   247				var = SvREFCNT_inc(var);
   248			    }
   249			    return newRV_noinc(var);
   250			}
   251			
   252			PerlIO *
   253			PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
   254					 int flags)
   255			{
   256			    if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
   257				PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar);
   258				PerlIOScalar *os = PerlIOSelf(o, PerlIOScalar);
   259				/* var has been set by implicit push */
   260				fs->posn = os->posn;
   261			    }
   262			    return f;
   263			}
   264			
   265			PERLIO_FUNCS_DECL(PerlIO_scalar) = {
   266			    sizeof(PerlIO_funcs),
   267			    "scalar",
   268			    sizeof(PerlIOScalar),
   269			    PERLIO_K_BUFFERED | PERLIO_K_RAW,
   270			    PerlIOScalar_pushed,
   271			    PerlIOScalar_popped,
   272			    PerlIOScalar_open,
   273			    PerlIOBase_binmode,
   274			    PerlIOScalar_arg,
   275			    PerlIOScalar_fileno,
   276			    PerlIOScalar_dup,
   277			    PerlIOBase_read,
   278			    PerlIOScalar_unread,
   279			    PerlIOScalar_write,
   280			    PerlIOScalar_seek,
   281			    PerlIOScalar_tell,
   282			    PerlIOScalar_close,
   283			    PerlIOScalar_flush,
   284			    PerlIOScalar_fill,
   285			    PerlIOBase_eof,
   286			    PerlIOBase_error,
   287			    PerlIOBase_clearerr,
   288			    PerlIOBase_setlinebuf,
   289			    PerlIOScalar_get_base,
   290			    PerlIOScalar_bufsiz,
   291			    PerlIOScalar_get_ptr,
   292			    PerlIOScalar_get_cnt,
   293			    PerlIOScalar_set_ptrcnt,
   294			};
   295			
   296			
   297			#endif /* Layers available */
   298			
   299			#ifndef PERL_UNUSED_VAR
   300			#  define PERL_UNUSED_VAR(var) if (0) var = var
   301			#endif
   302			
   303			#line 304 "scalar.c"
   304			#ifdef __cplusplus
   305			extern "C"
   306			#endif
   307			XS(boot_PerlIO__scalar); /* prototype to pass -Wmissing-prototypes */
   308			XS(boot_PerlIO__scalar)
   309	          16    {
   310	          16        dXSARGS;
   311			
   312	          16        PERL_UNUSED_VAR(cv); /* -W */
   313	          16        PERL_UNUSED_VAR(items); /* -W */
   314	          16        XS_VERSION_BOOTCHECK ;
   315			
   316			
   317			    /* Initialisation Section */
   318			
   319			#line 295 "scalar.xs"
   320			{
   321			#ifdef PERLIO_LAYERS
   322			 PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar));
   323			#endif
   324			}
   325			
   326			#line 327 "scalar.c"
   327			
   328			    /* End of Initialisation Section */
   329			
   330	          16        XSRETURN_YES;
   331			}
   332