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