This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
2c5883ae4e1a91c4391605ec3c3f1ff245766a9f
[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 /* 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