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