[perl5.git] / symbian / PerlApp.cpp

/* Copyright (c) 2004-2005 Nokia. All rights reserved. */

/* The PerlApp application is licensed under the same terms as Perl itself.
 *
 * Note that this PerlApp is for Symbian/Series 60/80/UIQ smartphones
 * and it has nothing whatsoever to do with the ActiveState PerlApp. */

#include "PerlApp.h"

#include <apparc.h>
#include <e32base.h>
#include <e32cons.h>
#include <eikenv.h>
#include <bautils.h>
#include <eikappui.h>
#include <utf.h>
#include <f32file.h>

#include <coemain.h>

#ifndef PerlAppMinimal

#include "PerlApp.hrh"

#endif //#ifndef PerlAppMinimal

#define PERL_GLOBAL_STRUCT
#define PERL_GLOBAL_STRUCT_PRIVATE

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "PerlBase.h"
#include "PerlUtil.h"

#define symbian_get_vars() Dll::Tls() // Not visible from perlXYZ.lib?

const TUid KPerlAppUid = {
#ifdef PerlAppMinimalUid
  PerlAppMinimalUid
#else
  0x102015F6
#endif
};

_LIT(KDefaultScript, "default.pl");

#ifdef PerlAppMinimalName
_LIT_NO_L(KAppName, PerlAppMinimalName);
#else
_LIT(KAppName, "PerlApp");
#endif

#ifndef PerlAppMinimal

_LIT_NO_L(KFlavor, PERL_SYMBIANSDK_FLAVOR);
_LIT(KAboutFormat,
     "Perl %d.%d.%d, Symbian port %d.%d.%d, built for %S SDK %d.%d");
_LIT(KCopyrightFormat,
     "Copyright 1987-2005 Larry Wall and others, Symbian port Copyright Nokia 2004-2005");
_LIT(KInboxPrefix, "\\System\\Mail\\");
_LIT(KScriptPrefix, "\\Perl\\");

_LIT8(KModulePrefix, SITELIB); // SITELIB from Perl config.h

typedef TBuf<256>  TMessageBuffer;
typedef TBuf8<256> TPeekBuffer;
typedef TBuf8<256> TFileName8;

#endif // #ifndef PerlAppMinimal

static void DoRunScriptL(TFileName aScriptName);

TUid CPerlAppApplication::AppDllUid() const
{
    return KPerlAppUid;
}

enum TPerlAppPanic
{
    EPerlAppCommandUnknown = 1
};

void Panic(TPerlAppPanic aReason)
{
    User::Panic(KAppName, aReason);
}

#ifndef PerlAppMinimal

// The isXXX() come from the Perl headers.
#define FILENAME_IS_ABSOLUTE(n) \
        (isALPHA(((n)[0])) && ((n)[1]) == ':' && ((n)[2]) == '\\')

static TBool IsInPerl(TFileName aFileName)
{
    TInt offset = aFileName.FindF(KScriptPrefix);
    return ((offset == 0 && // \foo
             aFileName[0] == '\\')
            ||
            (offset == 2 && // x:\foo
             FILENAME_IS_ABSOLUTE(aFileName)));
}

static TBool IsInInbox(TFileName aFileName)
{
    TInt offset = aFileName.FindF(KInboxPrefix);
    return ((offset == 0 && // \foo
             aFileName[0] == '\\')
            ||
            (offset == 2 && // x:\foo
             FILENAME_IS_ABSOLUTE(aFileName)));
}

static TBool IsPerlModule(TParsePtrC aParsed)
{
    return aParsed.Ext().CompareF(_L(".pm")) == 0;
}

static TBool IsPerlScript(TParsePtrC aParsed)
{
    return aParsed.Ext().CompareF(_L(".pl")) == 0;
}

static void CopyFromInboxL(RFs aFs, const TFileName& aSrc, const TFileName& aDst)
{
    TBool proceed = ETrue;
    TMessageBuffer message;

    message.Format(_L("%S is untrusted. Install only if you trust provider."), &aDst);
    if (CPerlUi::OkCancelDialogL(message)) {
        message.Format(_L("Install as %S?"), &aDst);
        if (CPerlUi::OkCancelDialogL(message)) {
            if (BaflUtils::FileExists(aFs, aDst)) {
                message.Format(_L("Replace old %S?"), &aDst);
                if (!CPerlUi::OkCancelDialogL(message))
                    proceed = EFalse;
            }
            if (proceed) {
                // Create directory?
                TInt err = BaflUtils::CopyFile(aFs, aSrc, aDst);
                if (err == KErrNone) {
                    message.Format(_L("Installed %S"), &aDst);
                    CPerlUi::InformationNoteL(message);
                }
                else {
                    message.Format(_L("Failure %d installing %S"), err, &aDst);
                    CPerlUi::WarningNoteL(message);
                }
            }
        }
    }
}

static TBool FindPerlPackageName(TPeekBuffer aPeekBuffer, TInt aOff, TFileName& aFn)
{
    aFn.SetMax();
    TInt m = aFn.MaxLength();
    TInt n = aPeekBuffer.Length();
    TInt i = 0;
    TInt j = aOff;

    aFn.SetMax();
    // The following is a little regular expression
    // engine that matches Perl package names.
    if (j < n && isSPACE(aPeekBuffer[j])) {
        while (j < n && isSPACE(aPeekBuffer[j])) j++;
        if (j < n && isALPHA(aPeekBuffer[j])) {
            while (j < n && isALNUM(aPeekBuffer[j])) {
                while (j < n &&
                       isALNUM(aPeekBuffer[j]) &&
                       i < m)
                    aFn[i++] = aPeekBuffer[j++];
                if (j + 1 < n &&
                    aPeekBuffer[j    ] == ':' &&
                    aPeekBuffer[j + 1] == ':' &&
                    i < m) {
                    aFn[i++] = '\\';
                    j += 2;
                    if (j < n &&
                        isALPHA(aPeekBuffer[j])) {
                        while (j < n &&
                               isALNUM(aPeekBuffer[j]) &&
                               i < m)
                            aFn[i++] = aPeekBuffer[j++];
                    }
                }
            }
            while (j < n && isSPACE(aPeekBuffer[j])) j++;
            if (j < n && aPeekBuffer[j] == ';' && i + 3 < m) {
                aFn.SetLength(i);
                aFn.Append(_L(".pm"));
                return ETrue;
            }
        }
    }
    return EFalse;
}

static void GuessPerlModule(TFileName& aGuess, TPeekBuffer aPeekBuffer, TParse aDrive)
{
   TInt offset = aPeekBuffer.Find(_L8("package"));
   if (offset != KErrNotFound) {
       const TInt KPackageLen = 7;
       TFileName q;

       if (!FindPerlPackageName(aPeekBuffer, offset + KPackageLen, q))
           return;

       TFileName8 p;
       p.Copy(aDrive.Drive());
       p.Append(KModulePrefix);

       aGuess.SetMax();
       if (p.Length() + 1 + q.Length() < aGuess.MaxLength()) {
           TInt i = 0, j;

           for (j = 0; j < p.Length(); j++)
               aGuess[i++] = p[j];
           aGuess[i++] = '\\';
           for (j = 0; j < q.Length(); j++)
               aGuess[i++] = q[j];
           aGuess.SetLength(i);
       }
       else
           aGuess.SetLength(0);
   }
}

static TBool LooksLikePerlL(TPeekBuffer aPeekBuffer)
{
    return aPeekBuffer.Left(2).Compare(_L8("#!")) == 0 &&
           aPeekBuffer.Find(_L8("perl")) != KErrNotFound;
}

static TBool InstallStuffL(const TFileName &aSrc, TParse aDrive, TParse aFile, TPeekBuffer aPeekBuffer, RFs aFs)
{
    TFileName aDst;
    TPtrC drive  = aDrive.Drive();
    TPtrC namext = aFile.NameAndExt();

    aDst.Format(_L("%S%S%S"), &drive, &KScriptPrefix, &namext);
    if (!IsPerlScript(aDst) && !LooksLikePerlL(aPeekBuffer)) {
        aDst.SetLength(0);
        if (IsPerlModule(aDst))
            GuessPerlModule(aDst, aPeekBuffer, aDrive);
    }
    if (aDst.Length() > 0) {
        CopyFromInboxL(aFs, aSrc, aDst);
        return ETrue;
    }

    return EFalse;
}

static TBool RunStuffL(const TFileName& aScriptName, TPeekBuffer aPeekBuffer)
{
    TBool isModule = EFalse;

    if (IsInPerl(aScriptName) &&
        (IsPerlScript(aScriptName) ||
         (isModule = IsPerlModule(aScriptName)) ||
         LooksLikePerlL(aPeekBuffer))) {
        TMessageBuffer message;

        if (isModule)
            message.Format(_L("Really run module %S?"), &aScriptName);
        else
            message.Format(_L("Run %S?"), &aScriptName);
        if (CPerlUi::YesNoDialogL(message))
            DoRunScriptL(aScriptName);
        return ETrue;
    }

    return EFalse;
}

void CPerlAppAppUi::InstallOrRunL(const TFileName& aFileName)
{
    TParse aFile;
    TParse aDrive;
    TMessageBuffer message;

    aFile.Set(aFileName, NULL, NULL);
    if (FILENAME_IS_ABSOLUTE(aFileName)) {
        aDrive.Set(aFileName, NULL, NULL);
    } else {
        TFileName appName =
          CEikonEnv::Static()->EikAppUi()->Application()->AppFullName();
        aDrive.Set(appName, NULL, NULL);
    }
    if (!iFs)
        iFs = &CEikonEnv::Static()->FsSession();
    RFile f;
    TInt err = f.Open(*iFs, aFileName, EFileRead);
    if (err == KErrNone) {
        TPeekBuffer aPeekBuffer;
        err = f.Read(aPeekBuffer);
        f.Close();  // Release quickly.
        if (err == KErrNone) {
            if (!(IsInInbox(aFileName) ?
                  InstallStuffL(aFileName, aDrive, aFile, aPeekBuffer, *iFs) :
                  RunStuffL(aFileName, aPeekBuffer))) {
                message.Format(_L("Failed for file %S"), &aFileName);
                CPerlUi::WarningNoteL(message);
            }
        } else {
            message.Format(_L("Error %d reading %S"), err, &aFileName);
            CPerlUi::WarningNoteL(message);
        }
    } else {
        message.Format(_L("Error %d opening %S"), err, &aFileName);
        CPerlUi::WarningNoteL(message);
    }
    if (iDoorObserver)
        delete CEikonEnv::Static()->EikAppUi();
    else
        Exit();
}

#endif /* #ifndef PerlAppMinimal */

CPerlAppAppUi::~CPerlAppAppUi()
{
    if (iAppView) {
        iEikonEnv->RemoveFromStack(iAppView);
        delete iAppView;
        iAppView = NULL;
    }
    if (iFs) {
        delete iFs;
        iFs = NULL;
    }
    if (iDoorObserver) // Otherwise the embedding application waits forever.
        iDoorObserver->NotifyExit(MApaEmbeddedDocObserver::EEmpty);
}

static void DoRunScriptL(TFileName aScriptName)
{
    CPerlBase* perl = CPerlBase::NewInterpreterLC();
    TRAPD(error, perl->RunScriptL(aScriptName));
#ifndef PerlAppMinimal
    if (error != KErrNone) {
        TMessageBuffer message;
        message.Format(_L("Error %d"), error);
        CPerlUi::YesNoDialogL(message);
    }
#endif // #ifndef PerlAppMinimal
    CleanupStack::PopAndDestroy(perl);
}

#ifndef PerlAppMinimal

void CPerlAppAppUi::OpenFileL(const TDesC& aFileName)
{
    InstallOrRunL(aFileName);
    return;
}

#endif // #ifndef PerlAppMinimal

TBool CPerlAppAppUi::ProcessCommandParametersL(TApaCommand aCommand, TFileName& /* aDocumentName */, const TDesC8& /* aTail */)
{
    if (aCommand == EApaCommandRun) {
        TFileName appName = Application()->AppFullName();
        TParse p;
        p.Set(KDefaultScript, &appName, NULL);
        TEntry aEntry;
        RFs aFs;
        aFs.Connect();
        if (aFs.Entry(p.FullName(), aEntry) == KErrNone) {
            DoRunScriptL(p.FullName());
            Exit();
        }
    }
    return aCommand == EApaCommandOpen ? ETrue : EFalse;
}

#ifndef PerlAppMinimal

void CPerlAppAppUi::SetFs(const RFs& aFs)
{
    iFs = (RFs*) &aFs;
}

#endif // #ifndef PerlAppMinimal

void CPerlAppAppUi::DoHandleCommandL(TInt aCommand) {
#ifndef PerlAppMinimal
    TMessageBuffer message;
#endif // #ifndef PerlAppMinimal

    switch(aCommand)
    {
#ifndef PerlAppMinimal
    case EPerlAppCommandAbout:
        {
            message.Format(KAboutFormat,
                           PERL_REVISION,
                           PERL_VERSION,
                           PERL_SUBVERSION,
                           PERL_SYMBIANPORT_MAJOR,
                           PERL_SYMBIANPORT_MINOR,
                           PERL_SYMBIANPORT_PATCH,
                           &KFlavor,
                           PERL_SYMBIANSDK_MAJOR,
                           PERL_SYMBIANSDK_MINOR
                           );
            CPerlUi::InformationNoteL(message);
        }
        break;
    case EPerlAppCommandTime:
        {
            CPerlBase* perl = CPerlBase::NewInterpreterLC();
            const char *const argv[] =
              { "perl", "-le",
                "print 'Running in ', $^O, \"\\n\", scalar localtime" };
            perl->ParseAndRun(sizeof(argv)/sizeof(char*), (char **)argv, 0);
            CleanupStack::PopAndDestroy(perl);
        }
        break;
#ifndef __UIQ__
     case EPerlAppCommandRunFile:
        {
            TFileName aScriptUtf16;
            aScriptUtf16.Copy(_L("C:\\"));
            if (CPerlUi::FileQueryDialogL(aScriptUtf16))
              DoRunScriptL(aScriptUtf16);
        }
        break;
#endif
     case EPerlAppCommandOneLiner:
        {
#ifdef __SERIES60__
            _LIT(prompt, "Oneliner:");
#endif /* #ifdef __SERIES60__ */
#if defined(__SERIES80__) || defined(__SERIES90__) || defined(__UIQ__)
            _LIT(prompt, "Code:"); // The title has "Oneliner" already.
#endif /* #if defined(__SERIES80__) || defined(__SERIES90__) || defined(__UIQ__) */
            CPerlAppAppUi* cAppUi =
              static_cast<CPerlAppAppUi*>(CEikonEnv::Static()->EikAppUi());
            if (CPerlUi::TextQueryDialogL(_L("Oneliner"),
                                          prompt,
                                          cAppUi->iOneLiner,
                                          KPerlUiOneLinerSize)) {
                const TUint KPerlUiUtf8Multi = 3; // Expansion multiplier.
                TBuf8<KPerlUiUtf8Multi * KPerlUiOneLinerSize> utf8;

                CnvUtfConverter::ConvertFromUnicodeToUtf8(utf8,
                                                          cAppUi->iOneLiner);
                CPerlBase* perl = CPerlBase::NewInterpreterLC();
#ifdef __SERIES90__
		int argc = 5;
#else
		int argc = 3;
#endif
		char **argv = (char**) malloc(argc * sizeof(char *));
                User::LeaveIfNull(argv);

                TCleanupItem argvCleanupItem = TCleanupItem(free, argv);
                CleanupStack::PushL(argvCleanupItem);
                argv[0] = (char *) "perl";
                argv[1] = (char *) "-le";
#ifdef __SERIES90__
                argv[2] = (char *) "unshift @INC, 'C:/Mydocs';";
                argv[3] = (char *) "-e";
                argv[4] = (char *) utf8.PtrZ();
#else
                argv[2] = (char *) utf8.PtrZ();
#endif
		perl->ParseAndRun(argc, argv);
                CleanupStack::PopAndDestroy(2, perl);
            }
        }
        break;
     case EPerlAppCommandCopyright:
        {
            message.Format(KCopyrightFormat);
            CPerlUi::InformationNoteL(message);
        }
        break;
     case EPerlAppCommandAboutCopyright:
        {
            TMessageBuffer m1;
            TMessageBuffer m2;
            m1.Format(KAboutFormat,
                      PERL_REVISION,
                      PERL_VERSION,
                      PERL_SUBVERSION,
                      PERL_SYMBIANPORT_MAJOR,
                      PERL_SYMBIANPORT_MINOR,
                      PERL_SYMBIANPORT_PATCH,
                      &KFlavor,
                      PERL_SYMBIANSDK_MAJOR,
                      PERL_SYMBIANSDK_MINOR
                      );
            CPerlUi::InformationNoteL(m1);
            User::After((TTimeIntervalMicroSeconds32) (1000*1000)); // 1 sec.
            m2.Format(KCopyrightFormat);
            CPerlUi::InformationNoteL(m2);
        }
        break;
#endif // #ifndef PerlAppMinimal
    default:
        Panic(EPerlAppCommandUnknown);
    }
}

CApaDocument* CPerlAppApplication::CreateDocumentL()
{
    CPerlAppDocument* cDoc = new (ELeave) CPerlAppDocument(*this);
    return cDoc;
}

CEikAppUi* CPerlAppDocument::CreateAppUiL()
{
    CPerlAppAppUi* cAppUi = new (ELeave) CPerlAppAppUi();
    return cAppUi;
}


#ifndef PerlAppMinimal

CFileStore* CPerlAppDocument::OpenFileL(TBool aDoOpen, const TDesC& aFileName, RFs& aFs)
{
    CPerlAppAppUi* cAppUi =
      static_cast<CPerlAppAppUi*>(CEikonEnv::Static()->EikAppUi());
    cAppUi->SetFs(aFs);
    if (aDoOpen)
        cAppUi->OpenFileL(aFileName);
    return NULL;
}

#endif // #ifndef PerlAppMinimal

EXPORT_C CApaApplication* NewApplication()
{
    return new CPerlAppApplication;
}

GLDEF_C TInt E32Dll(TDllReason /*aReason*/)
{
    return KErrNone;
}
Commit	Line	Data
27da23d5 JH	1	/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
27da23d5 JH	2
0added8b	3	/* The PerlApp application is licensed under the same terms as Perl itself.
d0d72822 JH	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. */
0added8b	7
27da23d5 JH	8	#include "PerlApp.h"
27da23d5 JH	9
27da23d5 JH	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
27da23d5 JH	19	#include <coemain.h>
27da23d5 JH	20
c7a4d1c0	21	#ifndef PerlAppMinimal
0added8b	22
27da23d5	23	#include "PerlApp.hrh"
ed76c0e4	24
c7a4d1c0	25	#endif //#ifndef PerlAppMinimal
0added8b	26
d0d72822 JH	27	#define PERL_GLOBAL_STRUCT
	28	#define PERL_GLOBAL_STRUCT_PRIVATE
	29
3c09d611	30	#include "EXTERN.h"
e0f47ab0	31	#include "perl.h"
d0d72822 JH	32	#include "XSUB.h"
d0d72822 JH	33
27da23d5	34	#include "PerlBase.h"
d0d72822 JH	35	#include "PerlUtil.h"
	36
	37	#define symbian_get_vars() Dll::Tls() // Not visible from perlXYZ.lib?
27da23d5	38
0added8b	39	const TUid KPerlAppUid = {
c7a4d1c0 JH	40	#ifdef PerlAppMinimalUid
c7a4d1c0 JH	41	PerlAppMinimalUid
0added8b JH	42	#else
	43	0x102015F6
	44	#endif
	45	};
	46
	47	_LIT(KDefaultScript, "default.pl");
27da23d5	48
c7a4d1c0 JH	49	#ifdef PerlAppMinimalName
c7a4d1c0 JH	50	_LIT_NO_L(KAppName, PerlAppMinimalName);
0added8b	51	#else
27da23d5	52	_LIT(KAppName, "PerlApp");
0added8b JH	53	#endif
0added8b JH	54
c7a4d1c0	55	#ifndef PerlAppMinimal
f26f4a2f	56
27da23d5 JH	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
c7a4d1c0	71	#endif // #ifndef PerlAppMinimal
f26f4a2f	72
f26f4a2f JH	73	static void DoRunScriptL(TFileName aScriptName);
f26f4a2f JH	74
27da23d5 JH	75	TUid CPerlAppApplication::AppDllUid() const
	76	{
	77	return KPerlAppUid;
	78	}
	79
53d44271	80	enum TPerlAppPanic
27da23d5 JH	81	{
	82	EPerlAppCommandUnknown = 1
	83	};
	84
	85	void Panic(TPerlAppPanic aReason)
	86	{
	87	User::Panic(KAppName, aReason);
	88	}
	89
c7a4d1c0	90	#ifndef PerlAppMinimal
0added8b	91
27da23d5 JH	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	{
53d44271	118	return aParsed.Ext().CompareF(_L(".pm")) == 0;
27da23d5 JH	119	}
	120
	121	static TBool IsPerlScript(TParsePtrC aParsed)
	122	{
53d44271	123	return aParsed.Ext().CompareF(_L(".pl")) == 0;
27da23d5 JH	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);
d0d72822	132	if (CPerlUi::OkCancelDialogL(message)) {
27da23d5	133	message.Format(_L("Install as %S?"), &aDst);
d0d72822	134	if (CPerlUi::OkCancelDialogL(message)) {
27da23d5 JH	135	if (BaflUtils::FileExists(aFs, aDst)) {
27da23d5 JH	136	message.Format(_L("Replace old %S?"), &aDst);
d0d72822	137	if (!CPerlUi::OkCancelDialogL(message))
27da23d5 JH	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);
d0d72822	145	CPerlUi::InformationNoteL(message);
27da23d5 JH	146	}
	147	else {
	148	message.Format(_L("Failure %d installing %S"), err, &aDst);
d0d72822	149	CPerlUi::WarningNoteL(message);
27da23d5 JH	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]) &&
53d44271	185	i < m)
27da23d5 JH	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();
53d44271	241	TPtrC namext = aFile.NameAndExt();
27da23d5 JH	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
27da23d5 JH	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);
53d44271	269	else
27da23d5	270	message.Format(_L("Run %S?"), &aScriptName);
d0d72822	271	if (CPerlUi::YesNoDialogL(message))
27da23d5	272	DoRunScriptL(aScriptName);
27da23d5 JH	273	return ETrue;
	274	}
	275
	276	return EFalse;
	277	}
	278
d0d72822	279	void CPerlAppAppUi::InstallOrRunL(const TFileName& aFileName)
27da23d5 JH	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);
d0d72822	306	CPerlUi::WarningNoteL(message);
27da23d5 JH	307	}
	308	} else {
	309	message.Format(_L("Error %d reading %S"), err, &aFileName);
d0d72822	310	CPerlUi::WarningNoteL(message);
27da23d5 JH	311	}
	312	} else {
	313	message.Format(_L("Error %d opening %S"), err, &aFileName);
d0d72822	314	CPerlUi::WarningNoteL(message);
27da23d5 JH	315	}
	316	if (iDoorObserver)
	317	delete CEikonEnv::Static()->EikAppUi();
	318	else
	319	Exit();
	320	}
	321
d0d72822 JH	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	}
0added8b JH	338
	339	static void DoRunScriptL(TFileName aScriptName)
	340	{
	341	CPerlBase* perl = CPerlBase::NewInterpreterLC();
	342	TRAPD(error, perl->RunScriptL(aScriptName));
c7a4d1c0	343	#ifndef PerlAppMinimal
0added8b JH	344	if (error != KErrNone) {
	345	TMessageBuffer message;
	346	message.Format(_L("Error %d"), error);
d0d72822	347	CPerlUi::YesNoDialogL(message);
0added8b	348	}
c7a4d1c0	349	#endif // #ifndef PerlAppMinimal
0added8b JH	350	CleanupStack::PopAndDestroy(perl);
	351	}
	352
c7a4d1c0	353	#ifndef PerlAppMinimal
f26f4a2f	354
d0d72822	355	void CPerlAppAppUi::OpenFileL(const TDesC& aFileName)
27da23d5 JH	356	{
	357	InstallOrRunL(aFileName);
	358	return;
	359	}
	360
c7a4d1c0	361	#endif // #ifndef PerlAppMinimal
f26f4a2f	362
d0d72822	363	TBool CPerlAppAppUi::ProcessCommandParametersL(TApaCommand aCommand, TFileName& /* aDocumentName /, const TDesC8& / aTail */)
27da23d5	364	{
0added8b JH	365	if (aCommand == EApaCommandRun) {
0added8b JH	366	TFileName appName = Application()->AppFullName();
ed76c0e4 JH	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	}
0added8b	376	}
27da23d5 JH	377	return aCommand == EApaCommandOpen ? ETrue : EFalse;
	378	}
	379
c7a4d1c0	380	#ifndef PerlAppMinimal
f26f4a2f	381
d0d72822	382	void CPerlAppAppUi::SetFs(const RFs& aFs)
27da23d5 JH	383	{
	384	iFs = (RFs*) &aFs;
	385	}
	386
c7a4d1c0	387	#endif // #ifndef PerlAppMinimal
f26f4a2f	388
d0d72822	389	void CPerlAppAppUi::DoHandleCommandL(TInt aCommand) {
c7a4d1c0	390	#ifndef PerlAppMinimal
27da23d5	391	TMessageBuffer message;
c7a4d1c0	392	#endif // #ifndef PerlAppMinimal
27da23d5 JH	393
	394	switch(aCommand)
	395	{
c7a4d1c0	396	#ifndef PerlAppMinimal
27da23d5 JH	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	);
d0d72822	410	CPerlUi::InformationNoteL(message);
27da23d5 JH	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;
d0d72822	423	#ifndef __UIQ__
27da23d5 JH	424	case EPerlAppCommandRunFile:
27da23d5 JH	425	{
27da23d5	426	TFileName aScriptUtf16;
d0d72822 JH	427	aScriptUtf16.Copy(_L("C:\\"));
	428	if (CPerlUi::FileQueryDialogL(aScriptUtf16))
	429	DoRunScriptL(aScriptUtf16);
	430	}
27da23d5	431	break;
d0d72822	432	#endif
27da23d5 JH	433	case EPerlAppCommandOneLiner:
27da23d5 JH	434	{
c7a4d1c0	435	#ifdef __SERIES60__
27da23d5	436	_LIT(prompt, "Oneliner:");
c7a4d1c0	437	#endif /* #ifdef __SERIES60__ */
53d44271	438	#if defined(__SERIES80__) \|\| defined(__SERIES90__) \|\| defined(__UIQ__)
c7a4d1c0	439	_LIT(prompt, "Code:"); // The title has "Oneliner" already.
53d44271	440	#endif /* #if defined(__SERIES80__) \|\| defined(__SERIES90__) \|\| defined(__UIQ__) */
d0d72822 JH	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);
27da23d5	452	CPerlBase* perl = CPerlBase::NewInterpreterLC();
53d44271 JH	453	#ifdef __SERIES90__
	454	int argc = 5;
	455	#else
	456	int argc = 3;
	457	#endif
	458	char argv = (char) malloc(argc * sizeof(char *));
27da23d5 JH	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";
53d44271 JH	465	#ifdef __SERIES90__
	466	argv[2] = (char *) "unshift @INC, 'C:/Mydocs';";
	467	argv[3] = (char *) "-e";
	468	argv[4] = (char *) utf8.PtrZ();
	469	#else
27da23d5	470	argv[2] = (char *) utf8.PtrZ();
53d44271 JH	471	#endif
53d44271 JH	472	perl->ParseAndRun(argc, argv);
27da23d5 JH	473	CleanupStack::PopAndDestroy(2, perl);
	474	}
	475	}
	476	break;
	477	case EPerlAppCommandCopyright:
	478	{
	479	message.Format(KCopyrightFormat);
d0d72822	480	CPerlUi::InformationNoteL(message);
27da23d5 JH	481	}
27da23d5 JH	482	break;
ed76c0e4 JH	483	case EPerlAppCommandAboutCopyright:
ed76c0e4 JH	484	{
d0d72822 JH	485	TMessageBuffer m1;
d0d72822 JH	486	TMessageBuffer m2;
ed76c0e4	487	m1.Format(KAboutFormat,
d0d72822 JH	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.
ed76c0e4	500	m2.Format(KCopyrightFormat);
d0d72822	501	CPerlUi::InformationNoteL(m2);
ed76c0e4 JH	502	}
ed76c0e4 JH	503	break;
c7a4d1c0	504	#endif // #ifndef PerlAppMinimal
27da23d5 JH	505	default:
27da23d5 JH	506	Panic(EPerlAppCommandUnknown);
ed76c0e4 JH	507	}
	508	}
	509
53d44271	510	CApaDocument* CPerlAppApplication::CreateDocumentL()
27da23d5	511	{
d0d72822 JH	512	CPerlAppDocument* cDoc = new (ELeave) CPerlAppDocument(*this);
d0d72822 JH	513	return cDoc;
27da23d5 JH	514	}
	515
	516	CEikAppUi* CPerlAppDocument::CreateAppUiL()
	517	{
d0d72822 JH	518	CPerlAppAppUi* cAppUi = new (ELeave) CPerlAppAppUi();
d0d72822 JH	519	return cAppUi;
27da23d5 JH	520	}
27da23d5 JH	521
f26f4a2f	522
c7a4d1c0	523	#ifndef PerlAppMinimal
f26f4a2f	524
ed76c0e4	525	CFileStore* CPerlAppDocument::OpenFileL(TBool aDoOpen, const TDesC& aFileName, RFs& aFs)
27da23d5	526	{
d0d72822 JH	527	CPerlAppAppUi* cAppUi =
	528	static_cast<CPerlAppAppUi*>(CEikonEnv::Static()->EikAppUi());
	529	cAppUi->SetFs(aFs);
ed76c0e4	530	if (aDoOpen)
d0d72822	531	cAppUi->OpenFileL(aFileName);
27da23d5 JH	532	return NULL;
	533	}
	534
c7a4d1c0	535	#endif // #ifndef PerlAppMinimal
f26f4a2f	536
53d44271	537	EXPORT_C CApaApplication* NewApplication()
27da23d5 JH	538	{
	539	return new CPerlAppApplication;
	540	}
	541
	542	GLDEF_C TInt E32Dll(TDllReason /aReason/)
	543	{
	544	return KErrNone;
	545	}
	546