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