1 /* Copyright (c) 2004-2005 Nokia. All rights reserved. */
3 /* The CPerlBase class is licensed under the same terms as Perl itself. */
5 /* See PerlBase.pod for documentation. */
15 const TUint KPerlConsoleBufferMaxTChars = 0x0200;
16 const TUint KPerlConsoleNoPos = 0xffff;
18 CPerlBase::CPerlBase()
22 EXPORT_C void CPerlBase::Destruct()
25 iState = EPerlDestroying;
27 iConsole->Printf(_L("[Any key to continue]"));
31 (void)perl_destruct(iPerl);
42 iConsoleBuffer = NULL;
44 #ifdef PERL_GLOBAL_STRUCT
46 PerlInterpreter* my_perl = NULL;
47 free_global_struct(iVars);
53 CPerlBase::~CPerlBase()
58 EXPORT_C CPerlBase* CPerlBase::NewInterpreter(TBool aCloseStdlib,
59 void (*aStdioInitFunc)(void*),
60 void *aStdioInitCookie)
62 CPerlBase* self = new (ELeave) CPerlBase;
63 self->iCloseStdlib = aCloseStdlib;
64 self->iStdioInitFunc = aStdioInitFunc;
65 self->iStdioInitCookie = aStdioInitCookie;
67 PERL_APPCTX_SET(self);
71 EXPORT_C CPerlBase* CPerlBase::NewInterpreterL(TBool aCloseStdlib,
72 void (*aStdioInitFunc)(void*),
73 void *aStdioInitCookie)
76 CPerlBase::NewInterpreterLC(aCloseStdlib,
79 CleanupStack::Pop(self);
83 EXPORT_C CPerlBase* CPerlBase::NewInterpreterLC(TBool aCloseStdlib,
84 void (*aStdioInitFunc)(void*),
85 void *aStdioInitCookie)
87 CPerlBase* self = new (ELeave) CPerlBase;
88 CleanupStack::PushL(self);
89 self->iCloseStdlib = aCloseStdlib;
90 self->iStdioInitFunc = aStdioInitFunc;
91 self->iStdioInitCookie = aStdioInitCookie;
93 PERL_APPCTX_SET(self);
97 static int _console_stdin(void* cookie, char* buf, int n)
99 return ((CPerlBase*)cookie)->ConsoleRead(0, buf, n);
102 static int _console_stdout(void* cookie, const char* buf, int n)
104 return ((CPerlBase*)cookie)->ConsoleWrite(1, buf, n);
107 static int _console_stderr(void* cookie, const char* buf, int n)
109 return ((CPerlBase*)cookie)->ConsoleWrite(2, buf, n);
112 void CPerlBase::StdioRewire(void *arg) {
113 _REENT->_sf[0]._cookie = (void*)this;
114 _REENT->_sf[0]._read = &_console_stdin;
115 _REENT->_sf[0]._write = 0;
116 _REENT->_sf[0]._seek = 0;
117 _REENT->_sf[0]._close = 0;
119 _REENT->_sf[1]._cookie = (void*)this;
120 _REENT->_sf[1]._read = 0;
121 _REENT->_sf[1]._write = &_console_stdout;
122 _REENT->_sf[1]._seek = 0;
123 _REENT->_sf[1]._close = 0;
125 _REENT->_sf[2]._cookie = (void*)this;
126 _REENT->_sf[2]._read = 0;
127 _REENT->_sf[2]._write = &_console_stderr;
128 _REENT->_sf[2]._seek = 0;
129 _REENT->_sf[2]._close = 0;
132 void CPerlBase::ConstructL()
135 #ifdef PERL_GLOBAL_STRUCT
136 PerlInterpreter *my_perl = 0;
137 iVars = init_global_struct();
138 User::LeaveIfNull(iVars);
140 iPerl = perl_alloc();
141 User::LeaveIfNull(iPerl);
142 iState = EPerlAllocated;
143 perl_construct(iPerl); // returns void
144 if (!iStdioInitFunc) {
146 Console::NewL(_L("Perl Console"),
147 TSize(KConsFullScreen, KConsFullScreen));
149 (TUint16*)malloc(sizeof(TUint) *
150 KPerlConsoleBufferMaxTChars);
151 User::LeaveIfNull(iConsoleBuffer);
154 iStdioInitFunc = &StdioRewire;
158 iStdioInitFunc(iStdioInitCookie);
161 iState = EPerlConstructed;
164 EXPORT_C PerlInterpreter* CPerlBase::GetInterpreter()
166 return (PerlInterpreter*) iPerl;
170 static void boot_DynaLoader(pTHX_ CV* cv) { }
172 EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
175 static void xs_init(pTHX)
178 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
181 EXPORT_C TInt CPerlBase::RunScriptL(const TDesC& aFileName,
185 TBuf8<KMaxFileName> scriptUtf8;
187 error = CnvUtfConverter::ConvertFromUnicodeToUtf8(scriptUtf8, aFileName);
188 User::LeaveIfError(error);
189 char *filename = (char*)scriptUtf8.PtrZ();
191 if (stat(filename, &st) == -1)
194 return KErrGeneral; /* Anything better? */
195 char **Argv = (char**)malloc(argc * sizeof(char*));
196 User::LeaveIfNull(Argv);
197 TCleanupItem ArgvCleanupItem = TCleanupItem(free, Argv);
198 CleanupStack::PushL(ArgvCleanupItem);
200 if (argv && argc > 2)
201 for (int i = 2; i < argc - 1; i++)
203 Argv[argc - 1] = filename;
204 error = this->ParseAndRun(argc, Argv, envp);
205 CleanupStack::PopAndDestroy(Argv);
207 return error == 0 ? KErrNone : KErrGeneral;
211 EXPORT_C int CPerlBase::Parse(int argc, char *argv[], char *envp[])
213 if (iState == EPerlConstructed) {
214 const char* const NullArgv[] = { "perl", "-e", "0" };
215 if (argc == 0 || argv == 0) {
217 argv = (char**) NullArgv;
219 PERL_SYS_INIT(&argc, &argv);
220 int parsed = perl_parse(iPerl, xs_init, argc, argv, envp);
222 iState = EPerlParsed;
228 EXPORT_C void CPerlBase::SetupExit()
230 if (iState == EPerlParsed) {
232 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
233 // PL_perl_destruct level of 2 would be nice but
234 // it causes "Unbalanced scopes" for some reason.
235 PL_perl_destruct_level = 1;
239 EXPORT_C int CPerlBase::Run()
241 if (iState == EPerlParsed) {
243 iState = EPerlRunning;
244 int ran = perl_run(iPerl);
245 iState = (ran == 0) ? EPerlSuccess : EPerlFailure;
251 EXPORT_C int CPerlBase::ParseAndRun(int argc, char *argv[], char *envp[])
253 int parsed = Parse(argc, argv, envp);
254 int ran = (parsed == 0) ? Run() : -1;
258 int CPerlBase::ConsoleReadLine()
263 TUint currX = KPerlConsoleNoPos;
264 TUint currY = KPerlConsoleNoPos;
265 TUint prevX = KPerlConsoleNoPos;
266 TUint prevY = KPerlConsoleNoPos;
267 TUint maxX = KPerlConsoleNoPos;
271 TKeyCode code = iConsole->Getch();
273 if (code == EKeyLineFeed || code == EKeyEnter) {
274 if (offset < KPerlConsoleBufferMaxTChars) {
275 iConsoleBuffer[offset++] = '\n';
276 iConsole->Printf(_L("\n"));
277 iConsoleBuffer[offset++] = 0;
282 TBool doBackward = EFalse;
283 TBool doBackspace = EFalse;
287 if (code == EKeyBackspace) {
289 iConsoleBuffer[--offset] = 0;
294 else if (offset < KPerlConsoleBufferMaxTChars) {
295 TChar ch = TChar(code);
298 iConsoleBuffer[offset++] = (unsigned short)code;
299 iConsole->Printf(_L("%c"), code);
302 currX = iConsole->WhereX();
303 currY = iConsole->WhereY();
304 if (maxX == KPerlConsoleNoPos && prevX != KPerlConsoleNoPos &&
305 prevY != KPerlConsoleNoPos && currY == prevY + 1)
309 iConsole->SetPos(currX - 1);
311 iConsole->SetPos(maxX, currY - 1);
313 TUint nowX = iConsole->WhereX();
314 TUint nowY = iConsole->WhereY();
315 iConsole->Printf(_L(" ")); /* scrub */
316 iConsole->SetPos(nowX, nowY);
325 int CPerlBase::ConsoleRead(const int fd, char* buf, int n)
328 return iReadFunc(fd, buf, n);
343 TBuf8<4 * KPerlConsoleBufferMaxTChars> aBufferUtf8;
344 TBuf16<KPerlConsoleBufferMaxTChars> aBufferUtf16;
345 int length = ConsoleReadLine();
348 iConsoleUsed += length;
350 aBufferUtf16.SetLength(length);
351 for (i = 0; i < length; i++)
352 aBufferUtf16[i] = iConsoleBuffer[i];
353 aBufferUtf8.SetLength(4 * length);
355 CnvUtfConverter::ConvertFromUnicodeToUtf8(aBufferUtf8, aBufferUtf16);
357 char *pUtf8 = (char*)aBufferUtf8.PtrZ();
358 int nUtf8 = aBufferUtf8.Size();
360 nUtf8 = n; /* Potential data loss. */
361 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
362 for (i = 0; i < nUtf8; i++)
366 for (i = 0; i < nUtf8; i+= UTF8SKIP(pUtf8 + i)) {
367 unsigned long u = utf8_to_uvchr((U8*)(pUtf8 + i), 0);
369 iConsole->Printf(_L("(keycode > 0xFF)\n"));
381 int CPerlBase::ConsoleWrite(const int fd, const char* buf, int n)
384 return iWriteFunc(fd, buf, n);
400 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
402 if (is_utf8_string((U8*)buf, n)) {
403 for (int i = 0; i < n; i += UTF8SKIP(buf + i)) {
404 TChar u = utf8_to_uvchr((U8*)(buf + i), 0);
405 iConsole->Printf(_L("%c"), u);
409 iConsole->Printf(_L("(malformed utf8: "));
410 for (int i = 0; i < n; i++)
411 iConsole->Printf(_L("%02x "), buf[i]);
412 iConsole->Printf(_L(")\n"));
415 for (int i = 0; i < n; i++) {
416 iConsole->Printf(_L("%c"), buf[i]);
420 iConsoleUsed += wrote;