Provide defined value for $TODO only where test is still failing.
[perl.git] / symbian / PerlBase.cpp
1 /* Copyright (c) 2004-2005 Nokia. All rights reserved. */
2
3 /* The CPerlBase class is licensed under the same terms as Perl itself. */
4
5 /* See PerlBase.pod for documentation. */
6
7 #define PERLBASE_CPP
8
9 #include <e32cons.h>
10 #include <e32keys.h>
11 #include <utf.h>
12
13 #include "PerlBase.h"
14
15 const TUint KPerlConsoleBufferMaxTChars = 0x0200;
16 const TUint KPerlConsoleNoPos           = 0xffff;
17
18 CPerlBase::CPerlBase()
19 {
20 }
21
22 EXPORT_C void CPerlBase::Destruct()
23 {
24     dTHX;
25     iState = EPerlDestroying;
26     if (iConsole) {
27         iConsole->Printf(_L("[Any key to continue]"));
28         iConsole->Getch();
29     }
30     if (iPerl)  {
31         (void)perl_destruct(iPerl);
32         perl_free(iPerl);
33         iPerl = NULL;
34         PERL_SYS_TERM();
35     }
36     if (iConsole) {
37         delete iConsole;
38         iConsole = NULL;
39     }
40     if (iConsoleBuffer) {
41         free(iConsoleBuffer);
42         iConsoleBuffer = NULL;
43     }
44 #ifdef PERL_GLOBAL_STRUCT
45     if (iVars) {
46         PerlInterpreter* my_perl = NULL;
47         free_global_struct(iVars);
48         iVars = NULL;
49     }
50 #endif
51 }
52
53 CPerlBase::~CPerlBase()
54 {
55     Destruct();
56 }
57
58 EXPORT_C CPerlBase* CPerlBase::NewInterpreter(TBool aCloseStdlib,
59                                                void (*aStdioInitFunc)(void*),
60                                                void *aStdioInitCookie)
61 {
62    CPerlBase* self = new (ELeave) CPerlBase;
63    self->iCloseStdlib     = aCloseStdlib;
64    self->iStdioInitFunc   = aStdioInitFunc;
65    self->iStdioInitCookie = aStdioInitCookie;
66    self->ConstructL();
67    PERL_APPCTX_SET(self);
68    return self;
69 }
70
71 EXPORT_C CPerlBase* CPerlBase::NewInterpreterL(TBool aCloseStdlib,
72                                                void (*aStdioInitFunc)(void*),
73                                                void *aStdioInitCookie)
74 {
75     CPerlBase* self =
76       CPerlBase::NewInterpreterLC(aCloseStdlib,
77                                   aStdioInitFunc,
78                                   aStdioInitCookie);
79     CleanupStack::Pop(self);
80     return self;
81 }
82
83 EXPORT_C CPerlBase* CPerlBase::NewInterpreterLC(TBool aCloseStdlib,
84                                                 void (*aStdioInitFunc)(void*),
85                                                 void *aStdioInitCookie)
86 {
87     CPerlBase* self = new (ELeave) CPerlBase;
88     CleanupStack::PushL(self);
89     self->iCloseStdlib     = aCloseStdlib;
90     self->iStdioInitFunc   = aStdioInitFunc;
91     self->iStdioInitCookie = aStdioInitCookie;
92     self->ConstructL();
93     PERL_APPCTX_SET(self);
94     return self;
95 }
96
97 static int _console_stdin(void* cookie, char* buf, int n)
98 {
99     return ((CPerlBase*)cookie)->ConsoleRead(0, buf, n);
100 }
101
102 static int _console_stdout(void* cookie, const char* buf, int n)
103 {
104     return ((CPerlBase*)cookie)->ConsoleWrite(1, buf, n);
105 }
106
107 static int _console_stderr(void* cookie, const char* buf, int n)
108 {
109     return ((CPerlBase*)cookie)->ConsoleWrite(2, buf, n);
110 }
111
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;
118
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;
124
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;
130 }
131
132 void CPerlBase::ConstructL()
133 {
134     iState = EPerlNone;
135 #ifdef PERL_GLOBAL_STRUCT
136     PerlInterpreter *my_perl = 0;
137     iVars = init_global_struct();
138     User::LeaveIfNull(iVars);
139 #endif
140     iPerl = perl_alloc();
141     User::LeaveIfNull(iPerl);
142     iState = EPerlAllocated;
143     perl_construct(iPerl); // returns void
144     if (!iStdioInitFunc) {
145         iConsole =
146           Console::NewL(_L("Perl Console"),
147                         TSize(KConsFullScreen, KConsFullScreen));
148         iConsoleBuffer =
149           (TUint16*)malloc(sizeof(TUint) *
150                            KPerlConsoleBufferMaxTChars);
151         User::LeaveIfNull(iConsoleBuffer);
152         iConsoleUsed = 0;
153 #ifndef USE_PERLIO
154         iStdioInitFunc = &StdioRewire;
155 #endif
156     }
157     if (iStdioInitFunc)
158         iStdioInitFunc(iStdioInitCookie);
159     iReadFunc  = NULL;
160     iWriteFunc = NULL;
161     iState = EPerlConstructed;
162 }
163
164 EXPORT_C PerlInterpreter* CPerlBase::GetInterpreter()
165 {
166     return (PerlInterpreter*) iPerl;
167 }
168
169 #ifdef PERL_MINIPERL
170 static void boot_DynaLoader(pTHX_ CV* cv) { }
171 #else
172 EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
173 #endif
174
175 static void xs_init(pTHX)
176 {
177     dXSUB_SYS;
178     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
179 }
180
181 EXPORT_C TInt CPerlBase::RunScriptL(const TDesC& aFileName,
182                                     int argc,
183                                     char **argv,
184                                     char *envp[]) {
185     TBuf8<KMaxFileName> scriptUtf8;
186     TInt error;
187     error = CnvUtfConverter::ConvertFromUnicodeToUtf8(scriptUtf8, aFileName);
188     User::LeaveIfError(error);
189     char *filename = (char*)scriptUtf8.PtrZ();
190     struct stat st;
191     if (stat(filename, &st) == -1)
192         return KErrNotFound;
193     if (argc < 2)
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);
199     Argv[0] = "perl";
200     if (argv && argc > 2)
201         for (int i = 2; i < argc - 1; i++)
202             Argv[i] = argv[i];
203     Argv[argc - 1] = filename;
204     error = this->ParseAndRun(argc, Argv, envp);
205     CleanupStack::PopAndDestroy(Argv);
206     Argv = 0;
207     return error == 0 ? KErrNone : KErrGeneral;
208 }
209
210
211 EXPORT_C int CPerlBase::Parse(int argc, char *argv[], char *envp[])
212 {
213     if (iState == EPerlConstructed) {
214         const char* const NullArgv[] = { "perl", "-e", "0" };
215         if (argc == 0 || argv == 0) {
216             argc = 3;
217             argv = (char**) NullArgv;
218         }
219         PERL_SYS_INIT(&argc, &argv);
220         int parsed = perl_parse(iPerl, xs_init, argc, argv, envp);
221         if (parsed == 0)
222             iState = EPerlParsed;
223         return parsed;
224     } else
225         return -1;
226 }
227
228 EXPORT_C void CPerlBase::SetupExit()
229 {
230     if (iState == EPerlParsed) {
231         diTHX;
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;
236     }
237 }
238
239 EXPORT_C int CPerlBase::Run()
240 {
241     if (iState == EPerlParsed) {
242         SetupExit();
243         iState = EPerlRunning;
244         int ran = perl_run(iPerl);
245         iState = (ran == 0) ? EPerlSuccess : EPerlFailure;
246         return ran;
247     } else
248         return -1;
249 }
250
251 EXPORT_C int CPerlBase::ParseAndRun(int argc, char *argv[], char *envp[])
252 {
253     int parsed = Parse(argc, argv, envp);
254     int ran    = (parsed == 0) ? Run() : -1;
255     return ran;
256 }
257
258 int CPerlBase::ConsoleReadLine()
259 {
260     if (!iConsole)
261         return -EIO;
262
263     TUint currX  = KPerlConsoleNoPos;
264     TUint currY  = KPerlConsoleNoPos;
265     TUint prevX  = KPerlConsoleNoPos;
266     TUint prevY  = KPerlConsoleNoPos;
267     TUint maxX   = KPerlConsoleNoPos;
268     TUint offset = 0;
269
270     for (;;) {
271         TKeyCode code = iConsole->Getch();
272
273         if (code == EKeyLineFeed || code == EKeyEnter) {
274             if (offset < KPerlConsoleBufferMaxTChars) {
275                 iConsoleBuffer[offset++] = '\n';
276                 iConsole->Printf(_L("\n"));
277                 iConsoleBuffer[offset++] = 0;
278             }
279             break;
280         }
281         else {
282             TBool doBackward  = EFalse;
283             TBool doBackspace = EFalse;
284
285             prevX = currX;
286             prevY = currY;
287             if (code == EKeyBackspace) {
288                 if (offset > 0) {
289                     iConsoleBuffer[--offset] = 0;
290                     doBackward  = ETrue;
291                     doBackspace = ETrue;
292                 }
293             }
294             else if (offset < KPerlConsoleBufferMaxTChars) {
295                 TChar ch = TChar(code);
296
297                 if (ch.IsPrint()) {
298                     iConsoleBuffer[offset++] = (unsigned short)code;
299                     iConsole->Printf(_L("%c"), code);
300                 }
301             }
302             currX = iConsole->WhereX();
303             currY = iConsole->WhereY();
304             if (maxX  == KPerlConsoleNoPos && prevX != KPerlConsoleNoPos &&
305                 prevY != KPerlConsoleNoPos && currY == prevY + 1)
306                 maxX = prevX;
307             if (doBackward) {
308                 if (currX > 0)
309                     iConsole->SetPos(currX - 1);
310                 else if (currY > 0)
311                     iConsole->SetPos(maxX, currY - 1);
312                 if (doBackspace) {
313                     TUint nowX = iConsole->WhereX();
314                     TUint nowY = iConsole->WhereY();
315                     iConsole->Printf(_L(" ")); /* scrub */
316                     iConsole->SetPos(nowX, nowY);
317                 }
318             }
319          }
320     }
321
322     return offset;
323 }
324
325 int CPerlBase::ConsoleRead(const int fd, char* buf, int n)
326 {
327     if (iReadFunc)
328         return iReadFunc(fd, buf, n);
329
330     if (!iConsole) {
331         errno = EIO;
332         return -1;
333     }
334
335     if (n < 0) {
336         errno = EINVAL;
337         return -1;
338     }
339
340     if (n == 0)
341         return 0;
342
343     TBuf8<4 * KPerlConsoleBufferMaxTChars> aBufferUtf8;
344     TBuf16<KPerlConsoleBufferMaxTChars>    aBufferUtf16;
345     int length = ConsoleReadLine();
346     int i;
347
348     iConsoleUsed += length;
349
350     aBufferUtf16.SetLength(length);
351     for (i = 0; i < length; i++)
352         aBufferUtf16[i] = iConsoleBuffer[i];
353     aBufferUtf8.SetLength(4 * length);
354
355     CnvUtfConverter::ConvertFromUnicodeToUtf8(aBufferUtf8, aBufferUtf16);
356
357     char *pUtf8 = (char*)aBufferUtf8.PtrZ();
358     int nUtf8 = aBufferUtf8.Size();
359     if (nUtf8 > n)
360         nUtf8 = n; /* Potential data loss. */
361 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
362     for (i = 0; i < nUtf8; i++)
363         buf[i] = pUtf8[i];
364 #else
365     dTHX;
366     for (i = 0; i < nUtf8; i+= UTF8SKIP(pUtf8 + i)) {
367         unsigned long u = utf8_to_uvchr_buf((U8*)(pUtf8 + i),
368                                             (U8*)(pUtf8 + nUtf8),
369                                             0);
370         if (u > 0xFF) {
371             iConsole->Printf(_L("(keycode > 0xFF)\n"));
372             buf[i] = 0;
373             return -1;
374         }
375         buf[i] = u;
376     }
377 #endif
378     if (nUtf8 < n)
379         buf[nUtf8] = 0;
380     return nUtf8;
381 }
382
383 int CPerlBase::ConsoleWrite(const int fd, const char* buf, int n)
384 {
385     if (iWriteFunc)
386         return iWriteFunc(fd, buf, n);
387
388     if (!iConsole) {
389         errno = EIO;
390         return -1;
391     }
392
393     if (n < 0) {
394         errno = EINVAL;
395         return -1;
396     }
397
398     if (n == 0)
399         return 0;
400
401     int wrote = 0;
402 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
403     dTHX;
404     if (is_utf8_string((U8*)buf, n)) {
405         for (int i = 0; i < n; i += UTF8SKIP(buf + i)) {
406             TChar u = valid_utf8_to_uvchr((U8*)(buf + i), 0);
407             iConsole->Printf(_L("%c"), u);
408             wrote++;
409         }
410     } else {
411         iConsole->Printf(_L("(malformed utf8: "));
412         for (int i = 0; i < n; i++)
413             iConsole->Printf(_L("%02x "), buf[i]);
414         iConsole->Printf(_L(")\n"));
415     }
416 #else
417     for (int i = 0; i < n; i++) {
418         iConsole->Printf(_L("%c"), buf[i]);
419     }
420     wrote = n;
421 #endif
422     iConsoleUsed += wrote;
423     return n;
424 }
425