This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Symbian blead update: Symbian port 0.2.0
[perl5.git] / 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