openkylin
/
perl
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
perl/symbian/PerlBase.cpp

426 lines
11 KiB
C++
Raw Blame History

/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
/* The CPerlBase class is licensed under the same terms as Perl itself. */
/* See PerlBase.pod for documentation. */
#define PERLBASE_CPP
#include <e32cons.h>
#include <e32keys.h>
#include <utf.h>
#include "PerlBase.h"
const TUint KPerlConsoleBufferMaxTChars = 0x0200;
const TUint KPerlConsoleNoPos = 0xffff;
CPerlBase::CPerlBase()
{
}
EXPORT_C void CPerlBase::Destruct()
{
dTHX;
iState = EPerlDestroying;
if (iConsole) {
iConsole->Printf(_L("[Any key to continue]"));
iConsole->Getch();
}
if (iPerl) {
(void)perl_destruct(iPerl);
perl_free(iPerl);
iPerl = NULL;
PERL_SYS_TERM();
}
if (iConsole) {
delete iConsole;
iConsole = NULL;
}
if (iConsoleBuffer) {
free(iConsoleBuffer);
iConsoleBuffer = NULL;
}
#ifdef PERL_GLOBAL_STRUCT
if (iVars) {
PerlInterpreter* my_perl = NULL;
free_global_struct(iVars);
iVars = NULL;
}
#endif
}
CPerlBase::~CPerlBase()
{
Destruct();
}
EXPORT_C CPerlBase* CPerlBase::NewInterpreter(TBool aCloseStdlib,
void (*aStdioInitFunc)(void*),
void *aStdioInitCookie)
{
CPerlBase* self = new (ELeave) CPerlBase;
self->iCloseStdlib = aCloseStdlib;
self->iStdioInitFunc = aStdioInitFunc;
self->iStdioInitCookie = aStdioInitCookie;
self->ConstructL();
PERL_APPCTX_SET(self);
return self;
}
EXPORT_C CPerlBase* CPerlBase::NewInterpreterL(TBool aCloseStdlib,
void (*aStdioInitFunc)(void*),
void *aStdioInitCookie)
{
CPerlBase* self =
CPerlBase::NewInterpreterLC(aCloseStdlib,
aStdioInitFunc,
aStdioInitCookie);
CleanupStack::Pop(self);
return self;
}
EXPORT_C CPerlBase* CPerlBase::NewInterpreterLC(TBool aCloseStdlib,
void (*aStdioInitFunc)(void*),
void *aStdioInitCookie)
{
CPerlBase* self = new (ELeave) CPerlBase;
CleanupStack::PushL(self);
self->iCloseStdlib = aCloseStdlib;
self->iStdioInitFunc = aStdioInitFunc;
self->iStdioInitCookie = aStdioInitCookie;
self->ConstructL();
PERL_APPCTX_SET(self);
return self;
}
static int _console_stdin(void* cookie, char* buf, int n)
{
return ((CPerlBase*)cookie)->ConsoleRead(0, buf, n);
}
static int _console_stdout(void* cookie, const char* buf, int n)
{
return ((CPerlBase*)cookie)->ConsoleWrite(1, buf, n);
}
static int _console_stderr(void* cookie, const char* buf, int n)
{
return ((CPerlBase*)cookie)->ConsoleWrite(2, buf, n);
}
void CPerlBase::StdioRewire(void *arg) {
_REENT->_sf[0]._cookie = (void*)this;
_REENT->_sf[0]._read = &_console_stdin;
_REENT->_sf[0]._write = 0;
_REENT->_sf[0]._seek = 0;
_REENT->_sf[0]._close = 0;
_REENT->_sf[1]._cookie = (void*)this;
_REENT->_sf[1]._read = 0;
_REENT->_sf[1]._write = &_console_stdout;
_REENT->_sf[1]._seek = 0;
_REENT->_sf[1]._close = 0;
_REENT->_sf[2]._cookie = (void*)this;
_REENT->_sf[2]._read = 0;
_REENT->_sf[2]._write = &_console_stderr;
_REENT->_sf[2]._seek = 0;
_REENT->_sf[2]._close = 0;
}
void CPerlBase::ConstructL()
{
iState = EPerlNone;
#ifdef PERL_GLOBAL_STRUCT
PerlInterpreter *my_perl = 0;
iVars = init_global_struct();
User::LeaveIfNull(iVars);
#endif
iPerl = perl_alloc();
User::LeaveIfNull(iPerl);
iState = EPerlAllocated;
perl_construct(iPerl); // returns void
if (!iStdioInitFunc) {
iConsole =
Console::NewL(_L("Perl Console"),
TSize(KConsFullScreen, KConsFullScreen));
iConsoleBuffer =
(TUint16*)malloc(sizeof(TUint) *
KPerlConsoleBufferMaxTChars);
User::LeaveIfNull(iConsoleBuffer);
iConsoleUsed = 0;
#ifndef USE_PERLIO
iStdioInitFunc = &StdioRewire;
#endif
}
if (iStdioInitFunc)
iStdioInitFunc(iStdioInitCookie);
iReadFunc = NULL;
iWriteFunc = NULL;
iState = EPerlConstructed;
}
EXPORT_C PerlInterpreter* CPerlBase::GetInterpreter()
{
return (PerlInterpreter*) iPerl;
}
#ifdef PERL_MINIPERL
static void boot_DynaLoader(pTHX_ CV* cv) { }
#else
EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
#endif
static void xs_init(pTHX)
{
dXSUB_SYS;
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
}
EXPORT_C TInt CPerlBase::RunScriptL(const TDesC& aFileName,
int argc,
char **argv,
char *envp[]) {
TBuf8<KMaxFileName> scriptUtf8;
TInt error;
error = CnvUtfConverter::ConvertFromUnicodeToUtf8(scriptUtf8, aFileName);
User::LeaveIfError(error);
char *filename = (char*)scriptUtf8.PtrZ();
struct stat st;
if (stat(filename, &st) == -1)
return KErrNotFound;
if (argc < 2)
return KErrGeneral; /* Anything better? */
char **Argv = (char**)malloc(argc * sizeof(char*));
User::LeaveIfNull(Argv);
TCleanupItem ArgvCleanupItem = TCleanupItem(free, Argv);
CleanupStack::PushL(ArgvCleanupItem);
Argv[0] = "perl";
if (argv && argc > 2)
for (int i = 2; i < argc - 1; i++)
Argv[i] = argv[i];
Argv[argc - 1] = filename;
error = this->ParseAndRun(argc, Argv, envp);
CleanupStack::PopAndDestroy(Argv);
Argv = 0;
return error == 0 ? KErrNone : KErrGeneral;
}
EXPORT_C int CPerlBase::Parse(int argc, char *argv[], char *envp[])
{
if (iState == EPerlConstructed) {
const char* const NullArgv[] = { "perl", "-e", "0" };
if (argc == 0 || argv == 0) {
argc = 3;
argv = (char**) NullArgv;
}
PERL_SYS_INIT(&argc, &argv);
int parsed = perl_parse(iPerl, xs_init, argc, argv, envp);
if (parsed == 0)
iState = EPerlParsed;
return parsed;
} else
return -1;
}
EXPORT_C void CPerlBase::SetupExit()
{
if (iState == EPerlParsed) {
diTHX;
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
// PL_perl_destruct level of 2 would be nice but
// it causes "Unbalanced scopes" for some reason.
PL_perl_destruct_level = 1;
}
}
EXPORT_C int CPerlBase::Run()
{
if (iState == EPerlParsed) {
SetupExit();
iState = EPerlRunning;
int ran = perl_run(iPerl);
iState = (ran == 0) ? EPerlSuccess : EPerlFailure;
return ran;
} else
return -1;
}
EXPORT_C int CPerlBase::ParseAndRun(int argc, char *argv[], char *envp[])
{
int parsed = Parse(argc, argv, envp);
int ran = (parsed == 0) ? Run() : -1;
return ran;
}
int CPerlBase::ConsoleReadLine()
{
if (!iConsole)
return -EIO;
TUint currX = KPerlConsoleNoPos;
TUint currY = KPerlConsoleNoPos;
TUint prevX = KPerlConsoleNoPos;
TUint prevY = KPerlConsoleNoPos;
TUint maxX = KPerlConsoleNoPos;
TUint offset = 0;
for (;;) {
TKeyCode code = iConsole->Getch();
if (code == EKeyLineFeed || code == EKeyEnter) {
if (offset < KPerlConsoleBufferMaxTChars) {
iConsoleBuffer[offset++] = '\n';
iConsole->Printf(_L("\n"));
iConsoleBuffer[offset++] = 0;
}
break;
}
else {
TBool doBackward = EFalse;
TBool doBackspace = EFalse;
prevX = currX;
prevY = currY;
if (code == EKeyBackspace) {
if (offset > 0) {
iConsoleBuffer[--offset] = 0;
doBackward = ETrue;
doBackspace = ETrue;
}
}
else if (offset < KPerlConsoleBufferMaxTChars) {
TChar ch = TChar(code);
if (ch.IsPrint()) {
iConsoleBuffer[offset++] = (unsigned short)code;
iConsole->Printf(_L("%c"), code);
}
}
currX = iConsole->WhereX();
currY = iConsole->WhereY();
if (maxX == KPerlConsoleNoPos && prevX != KPerlConsoleNoPos &&
prevY != KPerlConsoleNoPos && currY == prevY + 1)
maxX = prevX;
if (doBackward) {
if (currX > 0)
iConsole->SetPos(currX - 1);
else if (currY > 0)
iConsole->SetPos(maxX, currY - 1);
if (doBackspace) {
TUint nowX = iConsole->WhereX();
TUint nowY = iConsole->WhereY();
iConsole->Printf(_L(" ")); /* scrub */
iConsole->SetPos(nowX, nowY);
}
}
}
}
return offset;
}
int CPerlBase::ConsoleRead(const int fd, char* buf, int n)
{
if (iReadFunc)
return iReadFunc(fd, buf, n);
if (!iConsole) {
errno = EIO;
return -1;
}
if (n < 0) {
errno = EINVAL;
return -1;
}
if (n == 0)
return 0;
TBuf8<4 * KPerlConsoleBufferMaxTChars> aBufferUtf8;
TBuf16<KPerlConsoleBufferMaxTChars> aBufferUtf16;
int length = ConsoleReadLine();
int i;
iConsoleUsed += length;
aBufferUtf16.SetLength(length);
for (i = 0; i < length; i++)
aBufferUtf16[i] = iConsoleBuffer[i];
aBufferUtf8.SetLength(4 * length);
CnvUtfConverter::ConvertFromUnicodeToUtf8(aBufferUtf8, aBufferUtf16);
char *pUtf8 = (char*)aBufferUtf8.PtrZ();
int nUtf8 = aBufferUtf8.Size();
if (nUtf8 > n)
nUtf8 = n; /* Potential data loss. */
#ifdef PERL_SYMBIAN_CONSOLE_UTF8
for (i = 0; i < nUtf8; i++)
buf[i] = pUtf8[i];
#else
dTHX;
for (i = 0; i < nUtf8; i+= UTF8SKIP(pUtf8 + i)) {
unsigned long u = utf8_to_uvchr_buf((U8*)(pUtf8 + i),
(U8*)(pUtf8 + nUtf8),
0);
if (u > 0xFF) {
iConsole->Printf(_L("(keycode > 0xFF)\n"));
buf[i] = 0;
return -1;
}
buf[i] = u;
}
#endif
if (nUtf8 < n)
buf[nUtf8] = 0;
return nUtf8;
}
int CPerlBase::ConsoleWrite(const int fd, const char* buf, int n)
{
if (iWriteFunc)
return iWriteFunc(fd, buf, n);
if (!iConsole) {
errno = EIO;
return -1;
}
if (n < 0) {
errno = EINVAL;
return -1;
}
if (n == 0)
return 0;
int wrote = 0;
#ifdef PERL_SYMBIAN_CONSOLE_UTF8
dTHX;
if (is_utf8_string((U8*)buf, n)) {
for (int i = 0; i < n; i += UTF8SKIP(buf + i)) {
TChar u = valid_utf8_to_uvchr((U8*)(buf + i), 0);
iConsole->Printf(_L("%c"), u);
wrote++;
}
} else {
iConsole->Printf(_L("(malformed utf8: "));
for (int i = 0; i < n; i++)
iConsole->Printf(_L("%02x "), buf[i]);
iConsole->Printf(_L(")\n"));
}
#else
for (int i = 0; i < n; i++) {
iConsole->Printf(_L("%c"), buf[i]);
}
wrote = n;
#endif
iConsoleUsed += wrote;
return n;
}
Reference in New Issue View Git Blame Copy Permalink