symbian/PerlApp.cpp

   1 /* Copyright (c) 2004-2005 Nokia. All rights reserved. */
   2
   3 /* The PerlApp application is licensed under the same terms as Perl itself.
   4  *
   5  * Note that this PerlApp is for Symbian/Series 60/80/UIQ smartphones
   6  * and it has nothing whatsoever to do with the ActiveState PerlApp. */
   7
   8 #include "PerlApp.h"
   9
  10 #include <apparc.h>
  11 #include <e32base.h>
  12 #include <e32cons.h>
  13 #include <eikenv.h>
  14 #include <bautils.h>
  15 #include <eikappui.h>
  16 #include <utf.h>
  17 #include <f32file.h>
  18
  19 #include <coemain.h>
  20
  21 #ifndef PerlAppMinimal
  22
  23 #include "PerlApp.hrh"
  24
  25 #endif //#ifndef PerlAppMinimal
  26
  27 #define PERL_GLOBAL_STRUCT
  28 #define PERL_GLOBAL_STRUCT_PRIVATE
  29
  30 #include "EXTERN.h"
  31 #include "perl.h"
  32 #include "XSUB.h"
  33
  34 #include "PerlBase.h"
  35 #include "PerlUtil.h"
  36
  37 #define symbian_get_vars() Dll::Tls() // Not visible from perlXYZ.lib?
  38
  39 const TUid KPerlAppUid = {
  40 #ifdef PerlAppMinimalUid
  41   PerlAppMinimalUid
  42 #else
  43   0x102015F6
  44 #endif
  45 };
  46
  47 _LIT(KDefaultScript, "default.pl");
  48
  49 #ifdef PerlAppMinimalName
  50 _LIT_NO_L(KAppName, PerlAppMinimalName);
  51 #else
  52 _LIT(KAppName, "PerlApp");
  53 #endif
  54
  55 #ifndef PerlAppMinimal
  56
  57 _LIT_NO_L(KFlavor, PERL_SYMBIANSDK_FLAVOR);
  58 _LIT(KAboutFormat,
  59      "Perl %d.%d.%d, Symbian port %d.%d.%d, built for %S SDK %d.%d");
  60 _LIT(KCopyrightFormat,
  61      "Copyright 1987-2005 Larry Wall and others, Symbian port Copyright Nokia 2004-2005");
  62 _LIT(KInboxPrefix, "\\System\\Mail\\");
  63 _LIT(KScriptPrefix, "\\Perl\\");
  64
  65 _LIT8(KModulePrefix, SITELIB); // SITELIB from Perl config.h
  66
  67 typedef TBuf<256>  TMessageBuffer;
  68 typedef TBuf8<256> TPeekBuffer;
  69 typedef TBuf8<256> TFileName8;
  70
  71 #endif // #ifndef PerlAppMinimal
  72
  73 static void DoRunScriptL(TFileName aScriptName);
  74
  75 TUid CPerlAppApplication::AppDllUid() const
  76 {
  77     return KPerlAppUid;
  78 }
  79
  80 enum TPerlAppPanic
  81 {
  82     EPerlAppCommandUnknown = 1
  83 };
  84
  85 void Panic(TPerlAppPanic aReason)
  86 {
  87     User::Panic(KAppName, aReason);
  88 }
  89
  90 #ifndef PerlAppMinimal
  91
  92 // The isXXX() come from the Perl headers.
  93 #define FILENAME_IS_ABSOLUTE(n) \
  94         (isALPHA(((n)[0])) && ((n)[1]) == ':' && ((n)[2]) == '\\')
  95
  96 static TBool IsInPerl(TFileName aFileName)
  97 {
  98     TInt offset = aFileName.FindF(KScriptPrefix);
  99     return ((offset == 0 && // \foo
 100              aFileName[0] == '\\')
 101             ||
 102             (offset == 2 && // x:\foo
 103              FILENAME_IS_ABSOLUTE(aFileName)));
 104 }
 105
 106 static TBool IsInInbox(TFileName aFileName)
 107 {
 108     TInt offset = aFileName.FindF(KInboxPrefix);
 109     return ((offset == 0 && // \foo
 110              aFileName[0] == '\\')
 111             ||
 112             (offset == 2 && // x:\foo
 113              FILENAME_IS_ABSOLUTE(aFileName)));
 114 }
 115
 116 static TBool IsPerlModule(TParsePtrC aParsed)
 117 {
 118     return aParsed.Ext().CompareF(_L(".pm")) == 0;
 119 }
 120
 121 static TBool IsPerlScript(TParsePtrC aParsed)
 122 {
 123     return aParsed.Ext().CompareF(_L(".pl")) == 0;
 124 }
 125
 126 static void CopyFromInboxL(RFs aFs, const TFileName& aSrc, const TFileName& aDst)
 127 {
 128     TBool proceed = ETrue;
 129     TMessageBuffer message;
 130
 131     message.Format(_L("%S is untrusted. Install only if you trust provider."), &aDst);
 132     if (CPerlUi::OkCancelDialogL(message)) {
 133         message.Format(_L("Install as %S?"), &aDst);
 134         if (CPerlUi::OkCancelDialogL(message)) {
 135             if (BaflUtils::FileExists(aFs, aDst)) {
 136                 message.Format(_L("Replace old %S?"), &aDst);
 137                 if (!CPerlUi::OkCancelDialogL(message))
 138                     proceed = EFalse;
 139             }
 140             if (proceed) {
 141                 // Create directory?
 142                 TInt err = BaflUtils::CopyFile(aFs, aSrc, aDst);
 143                 if (err == KErrNone) {
 144                     message.Format(_L("Installed %S"), &aDst);
 145                     CPerlUi::InformationNoteL(message);
 146                 }
 147                 else {
 148                     message.Format(_L("Failure %d installing %S"), err, &aDst);
 149                     CPerlUi::WarningNoteL(message);
 150                 }
 151             }
 152         }
 153     }
 154 }
 155
 156 static TBool FindPerlPackageName(TPeekBuffer aPeekBuffer, TInt aOff, TFileName& aFn)
 157 {
 158     aFn.SetMax();
 159     TInt m = aFn.MaxLength();
 160     TInt n = aPeekBuffer.Length();
 161     TInt i = 0;
 162     TInt j = aOff;
 163
 164     aFn.SetMax();
 165     // The following is a little regular expression
 166     // engine that matches Perl package names.
 167     if (j < n && isSPACE(aPeekBuffer[j])) {
 168         while (j < n && isSPACE(aPeekBuffer[j])) j++;
 169         if (j < n && isALPHA(aPeekBuffer[j])) {
 170             while (j < n && isALNUM(aPeekBuffer[j])) {
 171                 while (j < n &&
 172                        isALNUM(aPeekBuffer[j]) &&
 173                        i < m)
 174                     aFn[i++] = aPeekBuffer[j++];
 175                 if (j + 1 < n &&
 176                     aPeekBuffer[j    ] == ':' &&
 177                     aPeekBuffer[j + 1] == ':' &&
 178                     i < m) {
 179                     aFn[i++] = '\\';
 180                     j += 2;
 181                     if (j < n &&
 182                         isALPHA(aPeekBuffer[j])) {
 183                         while (j < n &&
 184                                isALNUM(aPeekBuffer[j]) &&
 185                                i < m)
 186                             aFn[i++] = aPeekBuffer[j++];
 187                     }
 188                 }
 189             }
 190             while (j < n && isSPACE(aPeekBuffer[j])) j++;
 191             if (j < n && aPeekBuffer[j] == ';' && i + 3 < m) {
 192                 aFn.SetLength(i);
 193                 aFn.Append(_L(".pm"));
 194                 return ETrue;
 195             }
 196         }
 197     }
 198     return EFalse;
 199 }
 200
 201 static void GuessPerlModule(TFileName& aGuess, TPeekBuffer aPeekBuffer, TParse aDrive)
 202 {
 203    TInt offset = aPeekBuffer.Find(_L8("package"));
 204    if (offset != KErrNotFound) {
 205        const TInt KPackageLen = 7;
 206        TFileName q;
 207
 208        if (!FindPerlPackageName(aPeekBuffer, offset + KPackageLen, q))
 209            return;
 210
 211        TFileName8 p;
 212        p.Copy(aDrive.Drive());
 213        p.Append(KModulePrefix);
 214
 215        aGuess.SetMax();
 216        if (p.Length() + 1 + q.Length() < aGuess.MaxLength()) {
 217            TInt i = 0, j;
 218
 219            for (j = 0; j < p.Length(); j++)
 220                aGuess[i++] = p[j];
 221            aGuess[i++] = '\\';
 222            for (j = 0; j < q.Length(); j++)
 223                aGuess[i++] = q[j];
 224            aGuess.SetLength(i);
 225        }
 226        else
 227            aGuess.SetLength(0);
 228    }
 229 }
 230
 231 static TBool LooksLikePerlL(TPeekBuffer aPeekBuffer)
 232 {
 233     return aPeekBuffer.Left(2).Compare(_L8("#!")) == 0 &&
 234            aPeekBuffer.Find(_L8("perl")) != KErrNotFound;
 235 }
 236
 237 static TBool InstallStuffL(const TFileName &aSrc, TParse aDrive, TParse aFile, TPeekBuffer aPeekBuffer, RFs aFs)
 238 {
 239     TFileName aDst;
 240     TPtrC drive  = aDrive.Drive();
 241     TPtrC namext = aFile.NameAndExt();
 242
 243     aDst.Format(_L("%S%S%S"), &drive, &KScriptPrefix, &namext);
 244     if (!IsPerlScript(aDst) && !LooksLikePerlL(aPeekBuffer)) {
 245         aDst.SetLength(0);
 246         if (IsPerlModule(aDst))
 247             GuessPerlModule(aDst, aPeekBuffer, aDrive);
 248     }
 249     if (aDst.Length() > 0) {
 250         CopyFromInboxL(aFs, aSrc, aDst);
 251         return ETrue;
 252     }
 253
 254     return EFalse;
 255 }
 256
 257 static TBool RunStuffL(const TFileName& aScriptName, TPeekBuffer aPeekBuffer)
 258 {
 259     TBool isModule = EFalse;
 260
 261     if (IsInPerl(aScriptName) &&
 262         (IsPerlScript(aScriptName) ||
 263          (isModule = IsPerlModule(aScriptName)) ||
 264          LooksLikePerlL(aPeekBuffer))) {
 265         TMessageBuffer message;
 266
 267         if (isModule)
 268             message.Format(_L("Really run module %S?"), &aScriptName);
 269         else
 270             message.Format(_L("Run %S?"), &aScriptName);
 271         if (CPerlUi::YesNoDialogL(message))
 272             DoRunScriptL(aScriptName);
 273         return ETrue;
 274     }
 275
 276     return EFalse;
 277 }
 278
 279 void CPerlAppAppUi::InstallOrRunL(const TFileName& aFileName)
 280 {
 281     TParse aFile;
 282     TParse aDrive;
 283     TMessageBuffer message;
 284
 285     aFile.Set(aFileName, NULL, NULL);
 286     if (FILENAME_IS_ABSOLUTE(aFileName)) {
 287         aDrive.Set(aFileName, NULL, NULL);
 288     } else {
 289         TFileName appName =
 290           CEikonEnv::Static()->EikAppUi()->Application()->AppFullName();
 291         aDrive.Set(appName, NULL, NULL);
 292     }
 293     if (!iFs)
 294         iFs = &CEikonEnv::Static()->FsSession();
 295     RFile f;
 296     TInt err = f.Open(*iFs, aFileName, EFileRead);
 297     if (err == KErrNone) {
 298         TPeekBuffer aPeekBuffer;
 299         err = f.Read(aPeekBuffer);
 300         f.Close();  // Release quickly.
 301         if (err == KErrNone) {
 302             if (!(IsInInbox(aFileName) ?
 303                   InstallStuffL(aFileName, aDrive, aFile, aPeekBuffer, *iFs) :
 304                   RunStuffL(aFileName, aPeekBuffer))) {
 305                 message.Format(_L("Failed for file %S"), &aFileName);
 306                 CPerlUi::WarningNoteL(message);
 307             }
 308         } else {
 309             message.Format(_L("Error %d reading %S"), err, &aFileName);
 310             CPerlUi::WarningNoteL(message);
 311         }
 312     } else {
 313         message.Format(_L("Error %d opening %S"), err, &aFileName);
 314         CPerlUi::WarningNoteL(message);
 315     }
 316     if (iDoorObserver)
 317         delete CEikonEnv::Static()->EikAppUi();
 318     else
 319         Exit();
 320 }
 321
 322 #endif /* #ifndef PerlAppMinimal */
 323
 324 CPerlAppAppUi::~CPerlAppAppUi()
 325 {
 326     if (iAppView) {
 327         iEikonEnv->RemoveFromStack(iAppView);
 328         delete iAppView;
 329         iAppView = NULL;
 330     }
 331     if (iFs) {
 332         delete iFs;
 333         iFs = NULL;
 334     }
 335     if (iDoorObserver) // Otherwise the embedding application waits forever.
 336         iDoorObserver->NotifyExit(MApaEmbeddedDocObserver::EEmpty);
 337 }
 338
 339 static void DoRunScriptL(TFileName aScriptName)
 340 {
 341     CPerlBase* perl = CPerlBase::NewInterpreterLC();
 342     TRAPD(error, perl->RunScriptL(aScriptName));
 343 #ifndef PerlAppMinimal
 344     if (error != KErrNone) {
 345         TMessageBuffer message;
 346         message.Format(_L("Error %d"), error);
 347         CPerlUi::YesNoDialogL(message);
 348     }
 349 #endif // #ifndef PerlAppMinimal
 350     CleanupStack::PopAndDestroy(perl);
 351 }
 352
 353 #ifndef PerlAppMinimal
 354
 355 void CPerlAppAppUi::OpenFileL(const TDesC& aFileName)
 356 {
 357     InstallOrRunL(aFileName);
 358     return;
 359 }
 360
 361 #endif // #ifndef PerlAppMinimal
 362
 363 TBool CPerlAppAppUi::ProcessCommandParametersL(TApaCommand aCommand, TFileName& /* aDocumentName */, const TDesC8& /* aTail */)
 364 {
 365     if (aCommand == EApaCommandRun) {
 366         TFileName appName = Application()->AppFullName();
 367         TParse p;
 368         p.Set(KDefaultScript, &appName, NULL);
 369         TEntry aEntry;
 370         RFs aFs;
 371         aFs.Connect();
 372         if (aFs.Entry(p.FullName(), aEntry) == KErrNone) {
 373             DoRunScriptL(p.FullName());
 374             Exit();
 375         }
 376     }
 377     return aCommand == EApaCommandOpen ? ETrue : EFalse;
 378 }
 379
 380 #ifndef PerlAppMinimal
 381
 382 void CPerlAppAppUi::SetFs(const RFs& aFs)
 383 {
 384     iFs = (RFs*) &aFs;
 385 }
 386
 387 #endif // #ifndef PerlAppMinimal
 388
 389 void CPerlAppAppUi::DoHandleCommandL(TInt aCommand) {
 390 #ifndef PerlAppMinimal
 391     TMessageBuffer message;
 392 #endif // #ifndef PerlAppMinimal
 393
 394     switch(aCommand)
 395     {
 396 #ifndef PerlAppMinimal
 397     case EPerlAppCommandAbout:
 398         {
 399             message.Format(KAboutFormat,
 400                            PERL_REVISION,
 401                            PERL_VERSION,
 402                            PERL_SUBVERSION,
 403                            PERL_SYMBIANPORT_MAJOR,
 404                            PERL_SYMBIANPORT_MINOR,
 405                            PERL_SYMBIANPORT_PATCH,
 406                            &KFlavor,
 407                            PERL_SYMBIANSDK_MAJOR,
 408                            PERL_SYMBIANSDK_MINOR
 409                            );
 410             CPerlUi::InformationNoteL(message);
 411         }
 412         break;
 413     case EPerlAppCommandTime:
 414         {
 415             CPerlBase* perl = CPerlBase::NewInterpreterLC();
 416             const char *const argv[] =
 417               { "perl", "-le",
 418                 "print 'Running in ', $^O, \"\\n\", scalar localtime" };
 419             perl->ParseAndRun(sizeof(argv)/sizeof(char*), (char **)argv, 0);
 420             CleanupStack::PopAndDestroy(perl);
 421         }
 422         break;
 423 #ifndef __UIQ__
 424      case EPerlAppCommandRunFile:
 425         {
 426             TFileName aScriptUtf16;
 427             aScriptUtf16.Copy(_L("C:\\"));
 428             if (CPerlUi::FileQueryDialogL(aScriptUtf16))
 429               DoRunScriptL(aScriptUtf16);
 430         }
 431         break;
 432 #endif
 433      case EPerlAppCommandOneLiner:
 434         {
 435 #ifdef __SERIES60__
 436             _LIT(prompt, "Oneliner:");
 437 #endif /* #ifdef __SERIES60__ */
 438 #if defined(__SERIES80__) || defined(__SERIES90__) || defined(__UIQ__)
 439             _LIT(prompt, "Code:"); // The title has "Oneliner" already.
 440 #endif /* #if defined(__SERIES80__) || defined(__SERIES90__) || defined(__UIQ__) */
 441             CPerlAppAppUi* cAppUi =
 442               static_cast<CPerlAppAppUi*>(CEikonEnv::Static()->EikAppUi());
 443             if (CPerlUi::TextQueryDialogL(_L("Oneliner"),
 444                                           prompt,
 445                                           cAppUi->iOneLiner,
 446                                           KPerlUiOneLinerSize)) {
 447                 const TUint KPerlUiUtf8Multi = 3; // Expansion multiplier.
 448                 TBuf8<KPerlUiUtf8Multi * KPerlUiOneLinerSize> utf8;
 449
 450                 CnvUtfConverter::ConvertFromUnicodeToUtf8(utf8,
 451                                                           cAppUi->iOneLiner);
 452                 CPerlBase* perl = CPerlBase::NewInterpreterLC();
 453 #ifdef __SERIES90__
 454                 int argc = 5;
 455 #else
 456                 int argc = 3;
 457 #endif
 458                 char **argv = (char**) malloc(argc * sizeof(char *));
 459                 User::LeaveIfNull(argv);
 460
 461                 TCleanupItem argvCleanupItem = TCleanupItem(free, argv);
 462                 CleanupStack::PushL(argvCleanupItem);
 463                 argv[0] = (char *) "perl";
 464                 argv[1] = (char *) "-le";
 465 #ifdef __SERIES90__
 466                 argv[2] = (char *) "unshift @INC, 'C:/Mydocs';";
 467                 argv[3] = (char *) "-e";
 468                 argv[4] = (char *) utf8.PtrZ();
 469 #else
 470                 argv[2] = (char *) utf8.PtrZ();
 471 #endif
 472                 perl->ParseAndRun(argc, argv);
 473                 CleanupStack::PopAndDestroy(2, perl);
 474             }
 475         }
 476         break;
 477      case EPerlAppCommandCopyright:
 478         {
 479             message.Format(KCopyrightFormat);
 480             CPerlUi::InformationNoteL(message);
 481         }
 482         break;
 483      case EPerlAppCommandAboutCopyright:
 484         {
 485             TMessageBuffer m1;
 486             TMessageBuffer m2;
 487             m1.Format(KAboutFormat,
 488                       PERL_REVISION,
 489                       PERL_VERSION,
 490                       PERL_SUBVERSION,
 491                       PERL_SYMBIANPORT_MAJOR,
 492                       PERL_SYMBIANPORT_MINOR,
 493                       PERL_SYMBIANPORT_PATCH,
 494                       &KFlavor,
 495                       PERL_SYMBIANSDK_MAJOR,
 496                       PERL_SYMBIANSDK_MINOR
 497                       );
 498             CPerlUi::InformationNoteL(m1);
 499             User::After((TTimeIntervalMicroSeconds32) (1000*1000)); // 1 sec.
 500             m2.Format(KCopyrightFormat);
 501             CPerlUi::InformationNoteL(m2);
 502         }
 503         break;
 504 #endif // #ifndef PerlAppMinimal
 505     default:
 506         Panic(EPerlAppCommandUnknown);
 507     }
 508 }
 509
 510 CApaDocument* CPerlAppApplication::CreateDocumentL()
 511 {
 512     CPerlAppDocument* cDoc = new (ELeave) CPerlAppDocument(*this);
 513     return cDoc;
 514 }
 515
 516 CEikAppUi* CPerlAppDocument::CreateAppUiL()
 517 {
 518     CPerlAppAppUi* cAppUi = new (ELeave) CPerlAppAppUi();
 519     return cAppUi;
 520 }
 521
 522
 523 #ifndef PerlAppMinimal
 524
 525 CFileStore* CPerlAppDocument::OpenFileL(TBool aDoOpen, const TDesC& aFileName, RFs& aFs)
 526 {
 527     CPerlAppAppUi* cAppUi =
 528       static_cast<CPerlAppAppUi*>(CEikonEnv::Static()->EikAppUi());
 529     cAppUi->SetFs(aFs);
 530     if (aDoOpen)
 531         cAppUi->OpenFileL(aFileName);
 532     return NULL;
 533 }
 534
 535 #endif // #ifndef PerlAppMinimal
 536
 537 EXPORT_C CApaApplication* NewApplication()
 538 {
 539     return new CPerlAppApplication;
 540 }
 541
 542 GLDEF_C TInt E32Dll(TDllReason /*aReason*/)
 543 {
 544     return KErrNone;
 545 }
 546