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     {
 145         PerlInterpreter *my_perl = iPerl;
 146         PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 147     }
 148     if (!iStdioInitFunc) {
 149         iConsole =
 150           Console::NewL(_L("Perl Console"),
 151                         TSize(KConsFullScreen, KConsFullScreen));
 152         iConsoleBuffer =
 153           (TUint16*)malloc(sizeof(TUint) *
 154                            KPerlConsoleBufferMaxTChars);
 155         User::LeaveIfNull(iConsoleBuffer);
 156         iConsoleUsed = 0;
 157 #ifndef USE_PERLIO
 158         iStdioInitFunc = &StdioRewire;
 159 #endif
 160     }
 161     if (iStdioInitFunc)
 162         iStdioInitFunc(iStdioInitCookie);
 163     iReadFunc  = NULL;
 164     iWriteFunc = NULL;
 165     iState = EPerlConstructed;
 166 }
 167
 168 EXPORT_C PerlInterpreter* CPerlBase::GetInterpreter()
 169 {
 170     return (PerlInterpreter*) iPerl;
 171 }
 172
 173 #ifdef PERL_MINIPERL
 174 static void boot_DynaLoader(pTHX_ CV* cv) { }
 175 #else
 176 EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
 177 #endif
 178
 179 static void xs_init(pTHX)
 180 {
 181     dXSUB_SYS;
 182     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
 183 }
 184
 185 EXPORT_C TInt CPerlBase::RunScriptL(const TDesC& aFileName,
 186                                     int argc,
 187                                     char **argv,
 188                                     char *envp[]) {
 189     TBuf8<KMaxFileName> scriptUtf8;
 190     TInt error;
 191     error = CnvUtfConverter::ConvertFromUnicodeToUtf8(scriptUtf8, aFileName);
 192     User::LeaveIfError(error);
 193     char *filename = (char*)scriptUtf8.PtrZ();
 194     struct stat st;
 195     if (stat(filename, &st) == -1)
 196         return KErrNotFound;
 197     if (argc < 2)
 198         return KErrGeneral; /* Anything better? */
 199     char **Argv = (char**)malloc(argc * sizeof(char*));
 200     User::LeaveIfNull(Argv);
 201     TCleanupItem ArgvCleanupItem = TCleanupItem(free, Argv);
 202     CleanupStack::PushL(ArgvCleanupItem);
 203     Argv[0] = "perl";
 204     if (argv && argc > 2)
 205         for (int i = 2; i < argc - 1; i++)
 206             Argv[i] = argv[i];
 207     Argv[argc - 1] = filename;
 208     error = this->ParseAndRun(argc, Argv, envp);
 209     CleanupStack::PopAndDestroy(Argv);
 210     Argv = 0;
 211     return error == 0 ? KErrNone : KErrGeneral;
 212 }
 213
 214
 215 EXPORT_C int CPerlBase::Parse(int argc, char *argv[], char *envp[])
 216 {
 217     if (iState == EPerlConstructed) {
 218         const char* const NullArgv[] = { "perl", "-e", "0" };
 219         if (argc == 0 || argv == 0) {
 220             argc = 3;
 221             argv = (char**) NullArgv;
 222         }
 223         PERL_SYS_INIT(&argc, &argv);
 224         int parsed = perl_parse(iPerl, xs_init, argc, argv, envp);
 225         if (parsed == 0)
 226             iState = EPerlParsed;
 227         return parsed;
 228     } else
 229         return -1;
 230 }
 231
 232 EXPORT_C void CPerlBase::SetupExit()
 233 {
 234     if (iState == EPerlParsed) {
 235         diTHX;
 236         PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 237         // PL_perl_destruct level of 2 would be nice but
 238         // it causes "Unbalanced scopes" for some reason.
 239         PL_perl_destruct_level = 1;
 240     }
 241 }
 242
 243 EXPORT_C int CPerlBase::Run()
 244 {
 245     if (iState == EPerlParsed) {
 246         SetupExit();
 247         iState = EPerlRunning;
 248         int ran = perl_run(iPerl);
 249         iState = (ran == 0) ? EPerlSuccess : EPerlFailure;
 250         return ran;
 251     } else
 252         return -1;
 253 }
 254
 255 EXPORT_C int CPerlBase::ParseAndRun(int argc, char *argv[], char *envp[])
 256 {
 257     int parsed = Parse(argc, argv, envp);
 258     int ran    = (parsed == 0) ? Run() : -1;
 259     return ran;
 260 }
 261
 262 int CPerlBase::ConsoleReadLine()
 263 {
 264     if (!iConsole)
 265         return -EIO;
 266
 267     TUint currX  = KPerlConsoleNoPos;
 268     TUint currY  = KPerlConsoleNoPos;
 269     TUint prevX  = KPerlConsoleNoPos;
 270     TUint prevY  = KPerlConsoleNoPos;
 271     TUint maxX   = KPerlConsoleNoPos;
 272     TUint offset = 0;
 273
 274     for (;;) {
 275         TKeyCode code = iConsole->Getch();
 276
 277         if (code == EKeyLineFeed || code == EKeyEnter) {
 278             if (offset < KPerlConsoleBufferMaxTChars) {
 279                 iConsoleBuffer[offset++] = '\n';
 280                 iConsole->Printf(_L("\n"));
 281                 iConsoleBuffer[offset++] = 0;
 282             }
 283             break;
 284         }
 285         else {
 286             TBool doBackward  = EFalse;
 287             TBool doBackspace = EFalse;
 288
 289             prevX = currX;
 290             prevY = currY;
 291             if (code == EKeyBackspace) {
 292                 if (offset > 0) {
 293                     iConsoleBuffer[--offset] = 0;
 294                     doBackward  = ETrue;
 295                     doBackspace = ETrue;
 296                 }
 297             }
 298             else if (offset < KPerlConsoleBufferMaxTChars) {
 299                 TChar ch = TChar(code);
 300
 301                 if (ch.IsPrint()) {
 302                     iConsoleBuffer[offset++] = (unsigned short)code;
 303                     iConsole->Printf(_L("%c"), code);
 304                 }
 305             }
 306             currX = iConsole->WhereX();
 307             currY = iConsole->WhereY();
 308             if (maxX  == KPerlConsoleNoPos && prevX != KPerlConsoleNoPos &&
 309                 prevY != KPerlConsoleNoPos && currY == prevY + 1)
 310                 maxX = prevX;
 311             if (doBackward) {
 312                 if (currX > 0)
 313                     iConsole->SetPos(currX - 1);
 314                 else if (currY > 0)
 315                     iConsole->SetPos(maxX, currY - 1);
 316                 if (doBackspace) {
 317                     TUint nowX = iConsole->WhereX();
 318                     TUint nowY = iConsole->WhereY();
 319                     iConsole->Printf(_L(" ")); /* scrub */
 320                     iConsole->SetPos(nowX, nowY);
 321                 }
 322             }
 323          }
 324     }
 325
 326     return offset;
 327 }
 328
 329 int CPerlBase::ConsoleRead(const int fd, char* buf, int n)
 330 {
 331     if (iReadFunc)
 332         return iReadFunc(fd, buf, n);
 333
 334     if (!iConsole) {
 335         errno = EIO;
 336         return -1;
 337     }
 338
 339     if (n < 0) {
 340         errno = EINVAL;
 341         return -1;
 342     }
 343
 344     if (n == 0)
 345         return 0;
 346
 347     TBuf8<4 * KPerlConsoleBufferMaxTChars> aBufferUtf8;
 348     TBuf16<KPerlConsoleBufferMaxTChars>    aBufferUtf16;
 349     int length = ConsoleReadLine();
 350     int i;
 351
 352     iConsoleUsed += length;
 353
 354     aBufferUtf16.SetLength(length);
 355     for (i = 0; i < length; i++)
 356         aBufferUtf16[i] = iConsoleBuffer[i];
 357     aBufferUtf8.SetLength(4 * length);
 358
 359     CnvUtfConverter::ConvertFromUnicodeToUtf8(aBufferUtf8, aBufferUtf16);
 360
 361     char *pUtf8 = (char*)aBufferUtf8.PtrZ();
 362     int nUtf8 = aBufferUtf8.Size();
 363     if (nUtf8 > n)
 364         nUtf8 = n; /* Potential data loss. */
 365 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
 366     for (i = 0; i < nUtf8; i++)
 367         buf[i] = pUtf8[i];
 368 #else
 369     dTHX;
 370     for (i = 0; i < nUtf8; i+= UTF8SKIP(pUtf8 + i)) {
 371         unsigned long u = utf8_to_uvchr_buf((U8*)(pUtf8 + i),
 372                                             (U8*)(pUtf8 + nUtf8),
 373                                             0);
 374         if (u > 0xFF) {
 375             iConsole->Printf(_L("(keycode > 0xFF)\n"));
 376             buf[i] = 0;
 377             return -1;
 378         }
 379         buf[i] = u;
 380     }
 381 #endif
 382     if (nUtf8 < n)
 383         buf[nUtf8] = 0;
 384     return nUtf8;
 385 }
 386
 387 int CPerlBase::ConsoleWrite(const int fd, const char* buf, int n)
 388 {
 389     if (iWriteFunc)
 390         return iWriteFunc(fd, buf, n);
 391
 392     if (!iConsole) {
 393         errno = EIO;
 394         return -1;
 395     }
 396
 397     if (n < 0) {
 398         errno = EINVAL;
 399         return -1;
 400     }
 401
 402     if (n == 0)
 403         return 0;
 404
 405     int wrote = 0;
 406 #ifdef PERL_SYMBIAN_CONSOLE_UTF8
 407     dTHX;
 408     if (is_utf8_string((U8*)buf, n)) {
 409         for (int i = 0; i < n; i += UTF8SKIP(buf + i)) {
 410             TChar u = valid_utf8_to_uvchr((U8*)(buf + i), 0);
 411             iConsole->Printf(_L("%c"), u);
 412             wrote++;
 413         }
 414     } else {
 415         iConsole->Printf(_L("(malformed utf8: "));
 416         for (int i = 0; i < n; i++)
 417             iConsole->Printf(_L("%02x "), buf[i]);
 418         iConsole->Printf(_L(")\n"));
 419     }
 420 #else
 421     for (int i = 0; i < n; i++) {
 422         iConsole->Printf(_L("%c"), buf[i]);
 423     }
 424     wrote = n;
 425 #endif
 426     iConsoleUsed += wrote;
 427     return n;
 428 }
 429