PXPerlWrap (PXPerl, reloaded)

//
//	Class:		CPerl
//  Desc.:		A class to embed a persistent Perl interpreter in your MFC app
//
//	Compiler:	Visual C++
//	Tested on:	Visual C++ 6.0, Visual C++ .NET
//
//	Version:	1.2
//
//	Created:	13/July/2003
//	Updated:	13/July/2003
//
//	Author:		PixiGreg			mailto:pixigreg@ifrance.com
//
//	Disclaimer
//	----------
//	THIS SOFTWARE AND THE ACCOMPANYING FILES ARE DISTRIBUTED "AS IS" AND WITHOUT
//	ANY WARRANTIES WHETHER EXPRESSED OR IMPLIED. NO REPONSIBILITIES FOR POSSIBLE
//	DAMAGES OR EVEN FUNCTIONALITY CAN BE TAKEN. THE USER MUST ASSUME THE ENTIRE
//	RISK OF USING THIS SOFTWARE.
//
//	Terms of Use
//	------------
//	THIS SOFTWARE IS FREE FOR PERSONAL USE OR FREEWARE APPLICATIONS.
//	IF YOU USE THIS SOFTWARE IN COMMERCIAL OR SHAREWARE APPLICATIONS YOU
//	ARE GENTLY ASKED TO DONATE 5$ (FIVE U.S. DOLLARS) OR 5 EUROS TO THE AUTHOR,
//  USING PAYPAL (CONTACT THE AUTHOR FOR DETAILS).
//
////////////////////////////////////////////////////////////////////////////////
//
//  Copyright Notices
//  -----------------
//
//  Perl : Copyright 1987-2002, Larry Wall.
//
//  To write this class, I inspired from the existing class CPerlWrap
//  (http://www.codeproject.com/useritems/CPerlWrap.asp) by Harold Bamford.
//  Copied section from this class have been marked as such
//  (using <CPerlWrap>...</CPerlWrap>).
//
//  The idea of persistent interpreter has been found in the Perl doc `perlembed' ;
//  perlembed : copyright (C) 1995, 1996, 1997, 1998 Doug MacEachern and Jon Orwant.
//
//  If you're looking for a good Perl distribution that includes Perl docs, I sug-
//  gest you ActivePerl (http://www.activestate.com) from ActiveState Corp., or
//  SiePerl (http://www.cpan.org/ports) under the GPL/Artistic license.
//
//  Credits for the `Disclaimer' and `Terms of use' goes directly to Davide' Calabro.
//
//


#pragma once

#include <afxtempl.h>
#include <shlwapi.h>


#ifdef _UNICODE
#error PXPerl no longer supports Unicode compilation
#endif



namespace PXPerl
{


class CPerl;


class CPerlConfigFile
{
	friend class CPerl;
public:

	////
	// Configurarion File Creation Helpers
	// -----------------------------------

	// Flushes the current configuration file contents to the disk
	//  (write the contents to a file).
	// Reset the current configuration file contents. 
	// szFile : [in] path to a file.
	// bReset(optional) : [in] reset the configuration file contents (m_strOutput) ?
	bool Flush(LPCSTR szFile, bool bReset=true);

	// Appends an integer type variable to current configuration file contents.
	// szVariable : [in] variable name (sample: abc for scalar $abc).
	// value : [in] value of variable.
	// szComment(optional) : [in] comment about variable.
	// pnDefault(optional) : [in] default value.
	void WriteInt(LPCSTR szVariable, int value, LPCSTR szComment=NULL,
		int *pnDefault=NULL);

	// Appends a boolean type variable to current configuration file contents.
	// szVariable : [in] variable name (sample: abc for scalar $abc).
	// value : [in] value of variable (true or false).
	// szComment(optional) : [in] comment about variable.
	// pbDefault(optional) : [in] default value.
	void WriteBool(LPCSTR szVariable, bool value, LPCSTR szComment=NULL,
		bool *pbDefault=NULL);

	// Appends a floating point type variable to current configuration file contents.
	// szVariable : [in] variable name (sample: abc for scalar $abc).
	// value : [in] value of variable.
	// szComment(optional) : [in] comment about variable.
	// pdDefault(optional) : [in] default value.
	void WriteFloat(LPCSTR szVariable, double value, LPCSTR szComment=NULL,
		double *pdDefault=NULL);

	// Appends a string type variable to current configuration file contents.
	// szVariable : [in] variable name (sample: abc for scalar $abc).
	// value : [in] value of variable.
	// szComment(optional) : [in] comment about variable.
	// cDelim(optional) : [in] string delimiter. MUST NOT BE A CHARACTER OF YOUR STRING.
	void WriteString(LPCSTR szVariable, LPCSTR value, LPCSTR szComment=NULL,
		char cDelim='~', CString *pstrDefault=NULL);

	// Appends a string array type variable to current configuration file contents.
	// szVariable : [in] variable name (sample: abc for array @abc).
	// array : [in] array.
	// szComment(optional) : [in] comment about variable.
	// cDelim(optional) : [in] strings delimiter. MUST NOT BE A CHARACTER OF YOUR STRINGS.
	void WriteStringArray(LPCSTR szVariable, CStringArray &array, LPCSTR szComment=NULL,
		char cDelim='~');

	// Gets current output (configuration file contents).
	// [returns] const string with configuration file contents.
	LPCSTR GetOutput(void)
	{
		return LPCSTR(m_strOutput);
	};

	// Appends your own stuff to current configuration file contents.
	// szText : [in] text to be appended.
	void Write(LPCSTR szText)
	{
		m_strOutput += szText;
	};

	// Empty the current configuration file contents.
	void Empty(void)
	{
		m_strOutput.Empty();
	};

protected:
	CString m_strOutput;

public:
	static LPCSTR g_szOutputFormat;
	static LPCSTR g_szOutputFormatWithDefault;
};


class CScript
{
	friend class CPerl;
public:
	CScript(int nIndex=-1)
	{
		m_nIndex = nIndex;
	};

	// Tells if the script object is valid.
	bool IsValid(void)
	{
		return m_nIndex >= 0;
	};

	// Tells if the script object is invalid.
	bool IsInvalid(void)
	{
		return m_nIndex < 0;
	};

protected:
	int m_nIndex;
};


class CPerl  
{
public:
	////
	// Constructor.
	CPerl();

	// Destructor calls Unload() if you forget it.
	virtual ~CPerl();


	////
	// Loads the persistent interpreter.
	// [returns] true if successfuly loaded or already loaded, false otherwise.
	bool Load(void);

	// Unloads the persistent interpreter and frees all memory.
	void Unload(void);


	////
	// Script compilation (parsing) functions.
	// szName : [in] an unique name to identify the script,
	//   must contain only letters and digits, mustn't start with a digit
	//		(will be used as a Perl package name).
	// All return a CScript object. Can be invalid in case of error.

	// Parses a string.
	CScript Compile(LPCSTR szName, LPCSTR szScript);

	// Parses a config file.
	CScript Compile(LPCSTR szName, const CPerlConfigFile& perlConfig);

	// Parses a RT_PERL resource.
	CScript Compile(LPCSTR szName, int nResID);

	/// Parses a file.
	CScript CompileFile(LPCSTR szName, LPCSTR szFile);

	// Executes a compiled script.
	// script : [in] a valid CScript object.
	// [returns] true is successful, false otherwise.
	bool Exec(const CScript& script);

	// Cleans the namespace (variables plus script itself)
	//   associated with a compiled script, freeing memory associated with it.
	// Note that the script object passed is no longer valid after cleaning.
	// script : [in] a valid CScript object.
	void Clean(CScript & script);

	// DoScript/DoFile are helpers to execute a single script a single time.
	// Note that you can't access scripts variables with these methods.
	// [returns] true if successfuly run, false otherwise.
	bool DoScript(LPCSTR szScript);
	bool DoScript(const CPerlConfigFile& perlConfig);
	bool DoScript(int nResID);
	bool DoFile(LPCSTR szFile);


	////
	// Checks the STDERR output of the interpreter.
	// Useful to know if any error occured.
	// [returns] true if strContents is not empty.
	bool GetSTDERR(CString &strContents);
	
	// Grabs the STDOUT output (the default output) of the interpreter.
	// [returns] true if strContents is not empty.
	bool GetSTDOUT(CString &strContents);

	// Empties STDERR output.
	void EmptySTDERR(void);

	// Empties STDOUT output.
	void EmptySTDOUT(void);
	
	// Empties both STDERR and STDOUT outputs.
	void EmptyOutputs(void);

	// Empty outputs automatically at each Compile/Exec call ? 
	void SetAutoEmpty(bool bAuto=true);


	////
	// Following functions are self explanatory I think.
	// script : [in] a valid CScript object.
	// szVariable : [in] variable name (sample: abc for scalar $abc, array @abc, hash %abc).
	// All return true if successful, false otherwise.

	// With Get* functions, in case of failure, the 'value' argument passed is not changed.

	bool SetInt(const CScript& script, LPCSTR szVariable, const int value);
	bool GetInt(const CScript& script, LPCSTR szVariable, int &value);
	bool SetFloat(const CScript& script, LPCSTR szVariable, const double value);
	bool GetFloat(const CScript& script, LPCSTR szVariable, double &value);
	bool SetString(const CScript& script, LPCSTR szVariable, LPCSTR value);
	bool GetString(const CScript& script, LPCSTR szVariable, CString &value);

	// Pass true for bAppend to append, for example,
	// the array you pass to the Perl array (SetArray).

	bool SetArray(const CScript& script, LPCSTR szVariable, const CStringArray &array,
		bool bAppend=false);
	bool GetArray(const CScript& script, LPCSTR szVariable, CStringArray &array,
		bool bAppend=false);
	bool SetHash(const CScript& script, LPCSTR szVariable, const CMapStringToString &hash,
		bool bAppend=false);
	bool GetHash(const CScript& script, LPCSTR szVariable, CMapStringToString &hash,
		bool bAppend=false);

protected:
	CArray<CString, const CString&> m_strAPackages; // Used to store package names
	int m_nMaxPackageIndex; // Somewhat upper bound of array above
	void *m_pMyPerl; // current instance of Perl (cast-ed as PerlInterpreter*)
	bool m_bAutoEmpty;

public:
	static CString g_strExeDir;
};


}