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