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