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