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