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         DoRunScriptL(p.FullName());
 462         return EFalse;
 463     }
 464     return aCommand == EApaCommandOpen ? ETrue : EFalse;
 465 }
 466
 467 void CPerlAppUi::SetFs(const RFs& aFs)
 468 {
 469     iFs = (RFs*) &aFs;
 470 }
 471
 472 void CPerlAppUi::HandleCommandL(TInt aCommand)
 473 {
 474 #ifndef PerlMin
 475     TMessageBuffer message;
 476 #endif // #ifndef PerlMin
 477
 478     switch(aCommand)
 479     {
 480     case EEikCmdExit:
 481     case EAknSoftkeyExit:
 482         Exit();
 483         break;
 484 #ifndef PerlMin
 485     case EPerlAppCommandAbout:
 486         {
 487             message.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             InformationNoteL(message);
 499         }
 500         break;
 501     case EPerlAppCommandTime:
 502         {
 503             CPerlBase* perl = CPerlBase::NewInterpreterLC();
 504             const char *const argv[] =
 505               { "perl", "-le",
 506                 "print 'Running in ', $^O, \"\\n\", scalar localtime" };
 507             perl->ParseAndRun(sizeof(argv)/sizeof(char*), (char **)argv, 0);
 508             CleanupStack::PopAndDestroy(perl);
 509         }
 510         break;
 511      case EPerlAppCommandRunFile:
 512         {
 513             InformationNoteL(message);
 514             TFileName aScriptUtf16;
 515             if (AknCommonDialogs::RunSelectDlgLD(aScriptUtf16,
 516                                                  R_MEMORY_SELECTION_DIALOG))
 517                 DoRunScriptL(aScriptUtf16);
 518         }
 519         break;
 520      case EPerlAppCommandOneLiner:
 521         {
 522             _LIT(prompt, "Oneliner:");
 523             if (TextQueryDialogL(prompt, iOneLiner, KPerlAppOneLinerSize)) {
 524                 const TUint KPerlAppUtf8Multi = 3;
 525                 TBuf8<KPerlAppUtf8Multi * KPerlAppOneLinerSize> utf8;
 526
 527                 CnvUtfConverter::ConvertFromUnicodeToUtf8(utf8, iOneLiner);
 528                 CPerlBase* perl = CPerlBase::NewInterpreterLC();
 529                 int argc = 3;
 530                 char **argv = (char**) malloc(argc * sizeof(char *));
 531                 User::LeaveIfNull(argv);
 532
 533                 TCleanupItem argvCleanupItem = TCleanupItem(free, argv);
 534                 CleanupStack::PushL(argvCleanupItem);
 535                 argv[0] = (char *) "perl";
 536                 argv[1] = (char *) "-le";
 537                 argv[2] = (char *) utf8.PtrZ();
 538                 perl->ParseAndRun(argc, argv);
 539                 CleanupStack::PopAndDestroy(2, perl);
 540             }
 541         }
 542         break;
 543      case EPerlAppCommandCopyright:
 544         {
 545             message.Format(KCopyrightFormat);
 546             InformationNoteL(message);
 547         }
 548         break;
 549 #endif // #ifndef PerlMin
 550     default:
 551         Panic(EPerlAppCommandUnknown);
 552         break;
 553     }
 554 }
 555
 556 CPerlAppView* CPerlAppView::NewL(const TRect& aRect)
 557 {
 558     CPerlAppView* self = CPerlAppView::NewLC(aRect);
 559     CleanupStack::Pop(self);
 560     return self;
 561 }
 562
 563 CPerlAppView* CPerlAppView::NewLC(const TRect& aRect)
 564 {
 565     CPerlAppView* self = new (ELeave) CPerlAppView;
 566     CleanupStack::PushL(self);
 567     self->ConstructL(aRect);
 568     return self;
 569 }
 570
 571 void CPerlAppView::ConstructL(const TRect& aRect)
 572 {
 573     CreateWindowL();
 574     SetRect(aRect);
 575     ActivateL();
 576 }
 577
 578 void CPerlAppView::Draw(const TRect& /*aRect*/) const
 579 {
 580     CWindowGc& gc = SystemGc();
 581     TRect rect = Rect();
 582     gc.Clear(rect);
 583 }
 584
 585 CApaDocument* CPerlAppApplication::CreateDocumentL()
 586 {
 587     CPerlAppDocument* document = new (ELeave) CPerlAppDocument(*this);
 588     return document;
 589 }
 590
 591 CEikAppUi* CPerlAppDocument::CreateAppUiL()
 592 {
 593     CPerlAppUi* appui = new (ELeave) CPerlAppUi();
 594     return appui;
 595 }
 596
 597 CFileStore* CPerlAppDocument::OpenFileL(TBool /* aDoOpen */, const TDesC& aFileName, RFs& aFs)
 598 {
 599     CPerlAppUi* appui =
 600       STATIC_CAST(CPerlAppUi*, CEikonEnv::Static()->EikAppUi());
 601     appui->SetFs(aFs);
 602     appui->OpenFileL(aFileName);
 603     return NULL;
 604 }
 605
 606 EXPORT_C CApaApplication* NewApplication()
 607 {
 608     return new CPerlAppApplication;
 609 }
 610
 611 GLDEF_C TInt E32Dll(TDllReason /*aReason*/)
 612 {
 613     return KErrNone;
 614 }
 615