[p5sagit/p5-mst-13.2.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 smartphones and has nothing
 * whatsoever to do with the ActiveState PerlApp. */

/* This source code can be compiled into "PerlApp" which is the simple
 * launchpad application/demonstrator, or into "PerlMin", which is the
 * minimal Perl-on-Series-60 application.  Define the cpp symbols
 * PerlMin (a boolean), PerlMinUid (the Symbian application uid in
 * the 0x... format), and PerlMinName (a C wide string, with the L prefix)
 * to compile as "PerlMin". */

#include "PerlApp.h"

#ifdef PerlMinSample
# define PerlMin
# define PerlMinUid 0x0beefadd
# define PerlMinName L"PerlMin"
#endif

#ifdef PerlMin
# ifndef PerlMinUid
#   error PerlMin defined but PerlMinUid undefined
# endif
# ifndef PerlMinName
#  error PerlMin defined but PerlMinName undefined
# endif
#endif

#include <avkon.hrh>
#include <aknnotewrappers.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 <AknCommonDialogs.h>

#ifndef __SERIES60_1X__
#include <CAknFileSelectionDialog.h>
#endif

#include <coemain.h>

#ifndef PerlMin

#include "PerlApp.hrh"
#include "PerlApp.rsg"

#endif // #ifndef PerlMin

#include "EXTERN.h"
#include "perl.h"
#include "PerlBase.h"

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

_LIT(KDefaultScript, "default.pl");

// This is like the Symbian _LIT() but without the embedded L prefix,
// which enables using #defined constants (which need to carry their
// own L prefix).
#ifndef _LIT_NO_L
# define _LIT_NO_L(n, s) static const TLitC<sizeof(s)/2> n={sizeof(s)/2-1,s}
#endif // #ifndef _LIT_NO_L

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

#ifndef PerlMin
_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
#endif // #ifndef PerlMin

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

// Usage: DEBUG_PRINTF((_L("%S"), &aStr))
#if 1
#define DEBUG_PRINTF(s) {TMessageBuffer message; message.Format s; YesNoDialogL(message);}
#endif

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

enum TPerlAppPanic 
{
    EPerlAppCommandUnknown = 1
};

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

void CPerlAppUi::ConstructL()
{
    BaseConstructL();
    iAppView = CPerlAppView::NewL(ClientRect());
    AddToStackL(iAppView);
    iFs = NULL;
    CEikonEnv::Static()->DisableExitChecks(ETrue); // Symbian FAQ-0577.
}

CPerlAppUi::~CPerlAppUi()
{
    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);

#ifndef PerlMin

static TBool DlgOk(CAknNoteDialog* dlg)
{
    return dlg && dlg->RunDlgLD() == EAknSoftkeyOk;
}

static TBool OkCancelDialogL(TDesC& aMessage)
{
    CAknNoteDialog* dlg =
        new (ELeave) CAknNoteDialog(CAknNoteDialog::EConfirmationTone);
    dlg->PrepareLC(R_OK_CANCEL_DIALOG);
    dlg->SetTextL(aMessage);
    return DlgOk(dlg);
}

static TBool YesNoDialogL(TDesC& aMessage)
{
    CAknNoteDialog* dlg =
        new (ELeave) CAknNoteDialog(CAknNoteDialog::EConfirmationTone);
    dlg->PrepareLC(R_YES_NO_DIALOG);
    dlg->SetTextL(aMessage);
    return DlgOk(dlg);
}

static TInt InformationNoteL(TDesC& aMessage)
{
    CAknInformationNote* note = new (ELeave) CAknInformationNote;
    return note->ExecuteLD(aMessage);
}

static TInt ConfirmationNoteL(TDesC& aMessage)
{
    CAknConfirmationNote* note = new (ELeave) CAknConfirmationNote;
    return note->ExecuteLD(aMessage);
}

static TInt WarningNoteL(TDesC& aMessage)
{
    CAknWarningNote* note = new (ELeave) CAknWarningNote;
    return note->ExecuteLD(aMessage);
}

static TInt TextQueryDialogL(const TDesC& aPrompt, TDes& aData, const TInt aMaxLength)
{
    CAknTextQueryDialog* dlg =
        new (ELeave) CAknTextQueryDialog(aData);
    dlg->SetPromptL(aPrompt);
    dlg->SetMaxLength(aMaxLength);
    return dlg->ExecuteLD(R_TEXT_QUERY_DIALOG);
}

// 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 (OkCancelDialogL(message)) {
        message.Format(_L("Install as %S?"), &aDst);
        if (OkCancelDialogL(message)) {
            if (BaflUtils::FileExists(aFs, aDst)) {
                message.Format(_L("Replace old %S?"), &aDst);
                if (!OkCancelDialogL(message))
                    proceed = EFalse;
            }
            if (proceed) {
                // Create directory?
                TInt err = BaflUtils::CopyFile(aFs, aSrc, aDst);
                if (err == KErrNone) {
                    message.Format(_L("Installed %S"), &aDst);
                    ConfirmationNoteL(message);
                }
                else {
                    message.Format(_L("Failure %d installing %S"), err, &aDst);
                    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 (YesNoDialogL(message))
            DoRunScriptL(aScriptName);

        return ETrue;
    }

    return EFalse;
}

void CPerlAppUi::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);
                WarningNoteL(message);
            }
        } else {
            message.Format(_L("Error %d reading %S"), err, &aFileName);
            WarningNoteL(message);
        }
    } else {
        message.Format(_L("Error %d opening %S"), err, &aFileName);
        WarningNoteL(message);
    }
    if (iDoorObserver)
        delete CEikonEnv::Static()->EikAppUi();
    else
        Exit();
}

#endif // #ifndef PerlMin

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

void CPerlAppUi::OpenFileL(const TDesC& aFileName)
{
#ifndef PerlMin
    InstallOrRunL(aFileName);
#else
    DoRunScriptL(aFileName);
#endif
    return;
}

TBool CPerlAppUi::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;
}

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

void CPerlAppUi::HandleCommandL(TInt aCommand)
{
#ifndef PerlMin
    TMessageBuffer message;
#endif // #ifndef PerlMin

    switch(aCommand)
    {
    case EEikCmdExit:
    case EAknSoftkeyExit:
        Exit();
        break;
#ifndef PerlMin
    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
                           );
            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;
     case EPerlAppCommandRunFile:
        {
            InformationNoteL(message);
            TFileName aScriptUtf16;
            if (AknCommonDialogs::RunSelectDlgLD(aScriptUtf16,
                                                 R_MEMORY_SELECTION_DIALOG))
                DoRunScriptL(aScriptUtf16);
        }
        break;
     case EPerlAppCommandOneLiner:
        {
            _LIT(prompt, "Oneliner:");
            if (TextQueryDialogL(prompt, iOneLiner, KPerlAppOneLinerSize)) {
                const TUint KPerlAppUtf8Multi = 3;
                TBuf8<KPerlAppUtf8Multi * KPerlAppOneLinerSize> utf8;

                CnvUtfConverter::ConvertFromUnicodeToUtf8(utf8, iOneLiner);
                CPerlBase* perl = CPerlBase::NewInterpreterLC();
                int argc = 3;
                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";
                argv[2] = (char *) utf8.PtrZ();
                perl->ParseAndRun(argc, argv);
                CleanupStack::PopAndDestroy(2, perl);
            }
        }
        break;
     case EPerlAppCommandCopyright:
        {
            message.Format(KCopyrightFormat);
            InformationNoteL(message);
        }
        break;
#endif // #ifndef PerlMin
    default:
        Panic(EPerlAppCommandUnknown);
        break;
    }
}

CPerlAppView* CPerlAppView::NewL(const TRect& aRect)
{
    CPerlAppView* self = CPerlAppView::NewLC(aRect);
    CleanupStack::Pop(self);
    return self;
}

CPerlAppView* CPerlAppView::NewLC(const TRect& aRect)
{
    CPerlAppView* self = new (ELeave) CPerlAppView;
    CleanupStack::PushL(self);
    self->ConstructL(aRect);
    return self;
}

void CPerlAppView::ConstructL(const TRect& aRect)
{
    CreateWindowL();
    SetRect(aRect);
    ActivateL();
}

void CPerlAppView::Draw(const TRect& /*aRect*/) const
{
    CWindowGc& gc = SystemGc();
    TRect rect = Rect();
    gc.Clear(rect);
}

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

CEikAppUi* CPerlAppDocument::CreateAppUiL()
{
    CPerlAppUi* appui = new (ELeave) CPerlAppUi();
    return appui;
}

CFileStore* CPerlAppDocument::OpenFileL(TBool /* aDoOpen */, const TDesC& aFileName, RFs& aFs)
{
    CPerlAppUi* appui =
      STATIC_CAST(CPerlAppUi*, CEikonEnv::Static()->EikAppUi());
    appui->SetFs(aFs);
    appui->OpenFileL(aFileName);
    return NULL;
}

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

GLDEF_C TInt E32Dll(TDllReason /*aReason*/)
{
    return KErrNone;
}
Commit	Line	Data
27da23d5	1	/* Copyright (c) 2004-2005 Nokia. All rights reserved. */
27da23d5	2
0added8b	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". */
27da23d5	13
	14	#include "PerlApp.h"
	15
0added8b	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
27da23d5	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
0added8b	50	#ifndef PerlMin
0added8b	51
27da23d5	52	#include "PerlApp.hrh"
	53	#include "PerlApp.rsg"
	54
0added8b	55	#endif // #ifndef PerlMin
0added8b	56
3c09d611	57	#include "EXTERN.h"
e0f47ab0	58	#include "perl.h"
27da23d5	59	#include "PerlBase.h"
27da23d5	60
0added8b	61	const TUid KPerlAppUid = {
	62	#ifdef PerlMinUid
	63	PerlMinUid
	64	#else
	65	0x102015F6
	66	#endif
	67	};
	68
	69	_LIT(KDefaultScript, "default.pl");
27da23d5	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
0added8b	75	# define _LIT_NO_L(n, s) static const TLitC<sizeof(s)/2> n={sizeof(s)/2-1,s}
27da23d5	76	#endif // #ifndef _LIT_NO_L
27da23d5	77
0added8b	78	#ifdef PerlMinName
	79	_LIT_NO_L(KAppName, PerlMinName);
	80	#else
27da23d5	81	_LIT(KAppName, "PerlApp");
0added8b	82	#endif
	83
	84	#ifndef PerlMin
27da23d5	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
0added8b	94	#endif // #ifndef PerlMin
27da23d5	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
0added8b	144	static void DoRunScriptL(TFileName aScriptName);
	145
	146	#ifndef PerlMin
	147
27da23d5	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
27da23d5	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
0added8b	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
27da23d5	445	void CPerlAppUi::OpenFileL(const TDesC& aFileName)
27da23d5	446	{
0added8b	447	#ifndef PerlMin
27da23d5	448	InstallOrRunL(aFileName);
0added8b	449	#else
	450	DoRunScriptL(aFileName);
	451	#endif
27da23d5	452	return;
	453	}
	454
	455	TBool CPerlAppUi::ProcessCommandParametersL(TApaCommand aCommand, TFileName& /* aDocumentName /, const TDesC8& / aTail */)
	456	{
0added8b	457	if (aCommand == EApaCommandRun) {
	458	TFileName appName = Application()->AppFullName();
	459	TParse p;
	460	p.Set(KDefaultScript, &appName, NULL);
d3279339	461	TEntry aEntry;
	462	RFs aFs;
	463	aFs.Connect();
	464	if (aFs.Entry(p.FullName(), aEntry) == KErrNone) {
	465	DoRunScriptL(p.FullName());
	466	Exit();
	467	}
0added8b	468	}
27da23d5	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	{
0added8b	479	#ifndef PerlMin
27da23d5	480	TMessageBuffer message;
0added8b	481	#endif // #ifndef PerlMin
27da23d5	482
	483	switch(aCommand)
	484	{
	485	case EEikCmdExit:
	486	case EAknSoftkeyExit:
	487	Exit();
	488	break;
0added8b	489	#ifndef PerlMin
27da23d5	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;
0added8b	554	#endif // #ifndef PerlMin
27da23d5	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