A Stream Class for Calling Perl from C++

Listing 2: PerlStream.cc

bool PerlValue::isInt() const // line 1
{ return SvIOK(value); }

int PerlValue::Int() const // line 4
{
  if (SvIOK(value) || SvNOK(value) || SvPOK(value)) {
    return SvIV(value);
  } else if (exception_flags & PerlStream::eBadCast) {
    string errstr = string("Casting from a Perl ") + typeStr() +
        " to an int";
    throw PerlBadCast(errstr);
  }
  return 0;         // Not a valid value, so make it 0
}
// ... Lots of other PerlValue functions

PerlStreamBuf::PerlStreamBuf(unsigned int flags)
  : streambuf(), mContext(eScalar), mExceptionFlags(flags) {}

PerlStreamBuf::~PerlStreamBuf()
{ freePerlValues(); }

int PerlStreamBuf::overflow(int c) // line 23
{ mBuffer += static_cast<char>(c); return c; }

streamsize PerlStreamBuf::xsputn(const char* s, streamsize n) // line 26
{ mBuffer.append(s, n); return n; }

bool PerlStreamBuf::execute() // line 29
{
  string err;
  dSP;
  I32 ax;
  
  freePerlValues(); // Free values from the previous eval
  if (mBuffer.length() == 0) return true;

  ENTER;
  SAVETMPS;
  PUSHMARK(sp);

  // Create the string we want to send to Perl, and send it
  sv_setsv(ERRSV, &PL_sv_undef);
  PUTBACK;
  SV *code = sv_2mortal(newSVpv(mBuffer.data(),mBuffer.size()));
  I32 nstackvals = perl_eval_sv(code, mContext|G_KEEPERR);

  // Now get the response
  SPAGAIN;
  if (SvTRUE(ERRSV)) {
    err = "Eval failed: " + mBuffer + ": " + SvPV(ERRSV, PL_na);
    for (I32 i = 0; i < nstackvals; ++i)
      POPs;
  } else {
    // Get the return values from the Perl stack.
    mRtnVals.resize(nstackvals);
    for (I32 i = nstackvals-1; i >= 0; --i) {
      SV* val = POPs;
      SvREFCNT_inc(val);
      mRtnVals[i] = val;
    }
  }
  PUTBACK;
  FREETMPS;
  LEAVE;

  // Initialize things for the next go around
  mBuffer.erase();
  mContext = eScalar;
  if (!errstr.empty()) {
    if (mExceptionFlags & PerlStream::eEvalFail)
      throw PerlEvalError(err);
    return false;
  } else {
      return true;
  }
}

void PerlStreamBuf::freePerlValues()
{
  vector<SV*>::iterator p;
  for (p = mRtnVals.begin(); p != mRtnVals.end(); ++p)
    if (*p) { SvREFCNT_dec(*p); *p = 0; }
  mRtnVals.clear();
}
— End of Listing —