RE: Sorry, no Win32CORE-update for you unless you use development version...
[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::NewInterpreterL(TBool aCloseStdlib,
59                                                void (*aStdioInitFunc)(void*),
60                                                void *aStdioInitCookie)
61 {
62     CPerlBase* self =
63       CPerlBase::NewInterpreterLC(aCloseStdlib,
64                                   aStdioInitFunc,
65                                   aStdioInitCookie);
66     CleanupStack::Pop(self);
67     return self;
68 }
69
70 EXPORT_C CPerlBase* CPerlBase::NewInterpreterLC(TBool aCloseStdlib,
71                                                 void (*aStdioInitFunc)(void*),
72                                                 void *aStdioInitCookie)
73 {
74     CPerlBase* self = new (ELeave) CPerlBase;
75     CleanupStack::PushL(self);
76     self->iCloseStdlib     = aCloseStdlib;
77     self->iStdioInitFunc   = aStdioInitFunc;
78     self->iStdioInitCookie = aStdioInitCookie;
79     self->ConstructL();
80     PERL_APPCTX_SET(self);
81     return self;
82 }
83
84 static int _console_stdin(void* cookie, char* buf, int n)
85 {
86     return ((CPerlBase*)cookie)->ConsoleRead(0, buf, n);
87 }
88
89 static int _console_stdout(void* cookie, const char* buf, int n)
90 {
91     return ((CPerlBase*)cookie)->ConsoleWrite(1, buf, n);
92 }
93
94 static int _console_stderr(void* cookie, const char* buf, int n)
95 {
96     return ((CPerlBase*)cookie)->ConsoleWrite(2, buf, n);
97 }
98
99 void CPerlBase::StdioRewire(void *arg) {
100     _REENT->_sf[0]._cookie = (void*)this;
101     _REENT->_sf[0]._read   = &_console_stdin;
102     _REENT->_sf[0]._write  = 0;
103     _REENT->_sf[0]._seek   = 0;
104     _REENT->_sf[0]._close  = 0;
105
106     _REENT->_sf[1]._cookie = (void*)this;
107     _REENT->_sf[1]._read   = 0;
108     _REENT->_sf[1]._write  = &_console_stdout;
109     _REENT->_sf[1]._seek   = 0;
110     _REENT->_sf[1]._close  = 0;
111
112     _REENT->_sf[2]._cookie = (void*)this;
113     _REENT->_sf[2]._read   = 0;
114     _REENT->_sf[2]._write  = &_console_stderr;
115     _REENT->_sf[2]._seek   = 0;
116     _REENT->_sf[2]._close  = 0;
117 }
118
119 void CPerlBase::ConstructL()
120 {
121     iState = EPerlNone;
122 #ifdef PERL_GLOBAL_STRUCT
123     PerlInterpreter *my_perl = 0;
124     iVars = init_global_struct();
125     User::LeaveIfNull(iVars);
126 #endif
127     iPerl = perl_alloc();
128     User::LeaveIfNull(iPerl);
129     iState = EPerlAllocated;
130     perl_construct(iPerl); // returns void
131     if (!iStdioInitFunc) {
132         iConsole =
133           Console::NewL(_L("Perl Console"),
134                         TSize(KConsFullScreen, KConsFullScreen));
135         iConsoleBuffer =
136           (TUint16*)malloc(sizeof(TUint) *
137                            KPerlConsoleBufferMaxTChars);
138         User::LeaveIfNull(iConsoleBuffer);
139         iConsoleUsed = 0;
140 #ifndef USE_PERLIO
141         iStdioInitFunc = &StdioRewire;
142 #endif
143     }
144     if (iStdioInitFunc)
145         iStdioInitFunc(iStdioInitCookie);
146     iReadFunc  = NULL;
147     iWriteFunc = NULL;
148     iState = EPerlConstructed;
149 }
150
151 EXPORT_C PerlInterpreter* CPerlBase::GetInterpreter()
152 {
153     return (PerlInterpreter*) iPerl;
154 }
155
156 #ifdef PERL_MINIPERL
157 static void boot_DynaLoader(pTHX_ CV* cv) { }
158 #else
159 EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
160 #endif
161
162 static void xs_init(pTHX)
163 {
164     dXSUB_SYS;
165     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
166 }
167
168 EXPORT_C TInt CPerlBase::RunScriptL(const TDesC& aFileName,
169                                     int argc,
170                                     char **argv,
171                                     char *envp[]) {
172     TBuf8<KMaxFileName> scriptUtf8;
173     TInt error;
174     error = CnvUtfConverter::ConvertFromUnicodeToUtf8(scriptUtf8, aFileName);
175     User::LeaveIfError(error);
176     char *filename = (char*)scriptUtf8.PtrZ();
177     struct stat st;
178     if (stat(filename, &st) == -1)
179         return KErrNotFound;
180     if (argc < 2)
181         return KErrGeneral; /* Anything better? */
182     char **Argv = (char**)malloc(argc * sizeof(char*));
183     User::LeaveIfNull(Argv);
184     TCleanupItem ArgvCleanupItem = TCleanupItem(free, Argv);
185     CleanupStack::PushL(ArgvCleanupItem);
186     Argv[0] = "perl";
187     if (argv && argc > 2)
188         for (int i = 2; i < argc - 1; i++)
189             Argv[i] = argv[i];
190     Argv[argc - 1] = filename;
191     error = this->ParseAndRun(argc, Argv, envp);
192     CleanupStack::PopAndDestroy(Argv);
193     Argv = 0;
194     return error == 0 ? KErrNone : KErrGeneral;
195 }
196
197
198 EXPORT_C int CPerlBase::Parse(int argc, char *argv[], char *envp[])
199 {
200     if (iState == EPerlConstructed) {
201         const char* const NullArgv[] = { "perl", "-e", "0" };
202         if (argc == 0 || argv == 0) {
203             argc = 3;
204             argv = (char**) NullArgv;
205         }
206         PERL_SYS_INIT(&argc, &argv);
207         int parsed = perl_parse(iPerl, xs_init, argc, argv, envp);
208         if (parsed == 0)
209             iState = EPerlParsed;
210         return parsed;
211     } else
212         return -1;
213 }
214
215 EXPORT_C void CPerlBase::SetupExit()
216 {
217     if (iState == EPerlParsed) {
218         diTHX;
219         PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
220         // PL_perl_destruct level of 2 would be nice but
221         // it causes "Unbalanced scopes" for some reason.
222         PL_perl_destruct_level = 1;
223     }
224 }
225
226 EXPORT_C int CPerlBase::Run()
227 {
228     if (iState == EPerlParsed) {
229         SetupExit();
230         iState = EPerlRunning;
231         int ran = perl_run(iPerl);
232         iState = (ran == 0) ? EPerlSuccess : EPerlFailure;
233         return ran;
234     } else
235         return -1;
236 }
237
238 EXPORT_C int CPerlBase::ParseAndRun(int argc, char *argv[], char *envp[])
239 {
240     int parsed = Parse(argc, argv, envp);
241     int ran    = (parsed == 0) ? Run() : -1;
242     return ran;
243 }
244
245 int CPerlBase::ConsoleReadLine()
246 {
247     if (!iConsole)
248         return -EIO;
249
250     TUint currX  = KPerlConsoleNoPos;
251     TUint currY  = KPerlConsoleNoPos;
252     TUint prevX  = KPerlConsoleNoPos;
253     TUint prevY  = KPerlConsoleNoPos;
254     TUint maxX   = KPerlConsoleNoPos;
255     TUint offset = 0;
256
257     for (;;) {
258         TKeyCode code = iConsole->Getch();
259
260         if (code == EKeyLineFeed || code == EKeyEnter) {
261             if (offset < KPerlConsoleBufferMaxTChars) {
262                 iConsoleBuffer[offset++] = '\n';
263                 iConsole->Printf(_L("\n"));
264                 iConsoleBuffer[offset++] = 0;
265             }
266             break;
267         }
268         else {
269             TBool doBackward  = EFalse;
270             TBool doBackspace = EFalse;
271
272             prevX = currX;
273             prevY = currY;
274             if (code == EKeyBackspace) {
275                 if (offset > 0) {
276                     iConsoleBuffer[--offset] = 0;
277                     doBackward  = ETrue;
278                     doBackspace = ETrue;
279                 }
280             }
281             else if (offset < KPerlConsoleBufferMaxTChars) {
282                 TChar ch = TChar(code);
283
284                 if (ch.IsPrint()) {
285                     iConsoleBuffer[offset++] = (unsigned short)code;
286                     iConsole->Printf(_L("%c"), code);
287                 }
288             }
289             currX = iConsole->WhereX();
290             currY = iConsole->WhereY();
291             if (maxX  == KPerlConsoleNoPos && prevX != KPerlConsoleNoPos &&
292                 prevY != KPerlConsoleNoPos && currY == prevY + 1)
293                 maxX = prevX;
294             if (doBackward) {
295                 if (currX > 0)
296                     iConsole->SetPos(currX - 1);
297                 else if (currY > 0)
298                     iConsole->SetPos(maxX, currY - 1);
299                 if (doBackspace) {
300                     TUint nowX = iConsole->WhereX();
301                     TUint nowY = iConsole->WhereY();
302                     iConsole->Printf(_L(" ")); /* scrub */
303                     iConsole->SetPos(nowX, nowY);
304                 }
305             }
306          }
307     }
308
309     return offset;
310 }
311
312 int CPerlBase::ConsoleRead(const int fd, char* buf, int n)
313 {
314     if (iReadFunc)
315         return iReadFunc(fd, buf, n);
316
317     if (!iConsole) {
318         errno = EIO;
319         return -1;
320     }
321
322     if (n < 0) {
323         errno = EINVAL;
324         return -1;
325     }
326
327     if (n == 0)
328         return 0;
329
330     TBuf8<4 * KPerlConsoleBufferMaxTChars> aBufferUtf8;
331     TBuf16<KPerlConsoleBufferMaxTChars>    aBufferUtf16;
332     int length = ConsoleReadLine();
333     int i;
334
335     iConsoleUsed += length;
336
337     aBufferUtf16.SetLength(length);
338     for (i = 0; i < length; i++)
339         aBufferUtf16[i] = iConsoleBuffer[i];
340     aBufferUtf8.SetLength(4 * length);
341
342     CnvUtfConverter::ConvertFromUnicodeToUtf8(aBufferUtf8, aBufferUtf16);
343
344     char *pUtf8 = (char*)aBufferUtf8.PtrZ();
345     int nUtf8 = aBufferUtf8.Size();
346     if (nUtf8 > n)
347         nUtf8 = n; /* Potential data loss. */
348 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
349     for (i = 0; i < nUtf8; i++)
350         buf[i] = pUtf8[i];
351 #else
352     dTHX;
353     for (i = 0; i < nUtf8; i+= UTF8SKIP(pUtf8 + i)) {
354         unsigned long u = utf8_to_uvchr((U8*)(pUtf8 + i), 0);
355         if (u > 0xFF) {
356             iConsole->Printf(_L("(keycode > 0xFF)\n"));
357             buf[i] = 0;
358             return -1;
359         }
360         buf[i] = u;
361     }
362 #endif
363     if (nUtf8 < n)
364         buf[nUtf8] = 0;
365     return nUtf8;
366 }
367
368 int CPerlBase::ConsoleWrite(const int fd, const char* buf, int n)
369 {
370     if (iWriteFunc)
371         return iWriteFunc(fd, buf, n);
372
373     if (!iConsole) {
374         errno = EIO;
375         return -1;
376     }
377
378     if (n < 0) {
379         errno = EINVAL;
380         return -1;
381     }
382
383     if (n == 0)
384         return 0;
385
386     int wrote = 0;
387 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
388     dTHX;
389     if (is_utf8_string((U8*)buf, n)) {
390         for (int i = 0; i < n; i += UTF8SKIP(buf + i)) {
391             TChar u = utf8_to_uvchr((U8*)(buf + i), 0);
392             iConsole->Printf(_L("%c"), u);
393             wrote++;
394         }
395     } else {
396         iConsole->Printf(_L("(malformed utf8: "));
397         for (int i = 0; i < n; i++)
398             iConsole->Printf(_L("%02x "), buf[i]);
399         iConsole->Printf(_L(")\n"));
400     }
401 #else
402     for (int i = 0; i < n; i++) {
403         iConsole->Printf(_L("%c"), buf[i]);
404     }
405     wrote = n;
406 #endif
407     iConsoleUsed += wrote;
408     return n;
409 }
410