PerlVisual Studio .NET 2002Visual C++ 7.1Visual Studio 6Visual C++ 7.0Windows 2003Windows 2000Visual C++ 6.0Windows XPMFCIntermediateDevVisual StudioWindowsC++
PXPerlWrap (PXPerl, 已重载)
3.88/5 (20投票s)
2003年7月13日
11分钟阅读
241225
764
一个全面的Perl嵌入解决方案。
"有时你可以用C写出更快的代码，但你总是可以用Perl写出更快的代码。因为你可以互相使用对方，随意组合它们。"
- perlembed by Jon Orwant and Doug MacEachern.
目录
概要
#include "PXPerlWrap/PXPerlWrap.h" PXInitializeRedirect(GetSafeHwnd()); // redirect output and errors PXSetUTF8(UTF8_auto); // set behaviour towards Perl UTF8 encoded strings; see doc CPerlInterpreter interp1, interp2 ... ; CScript script1, script2 ...; interp1.Load(true); // load a persistent interpreter interp2.Load(false); // load a standard interpreter script1.Load(_T("http://pixigreg.com/hello2.txt"), URL, Plain); // load a script from the web interp1.Parse(script1); // parse it with interp #1 interp2.Parse(script1); // parse it with interp #2 interp1.Run(script1); // run it interp2.Run(script1); // interp1.Run(script1); // interp2.Run(script1); // // persistent interpreter benefit: you can clean // the script, freeing associated variables interp1.Clean(script1); script2.Load(_T("use Win32; Win32::MsgBox('Hello from Perl!');" " our $test_scalar = 'abc';"), Inline, Plain); if (!script2.Test()) // test syntax { // scripts failed to parse } script.Reformat(); // script will be reformated to output interp1.Parse(script2); CPerlScalar s = interp1.GetScalar(script2, _T("test_scalar")); s += _T("def"); CPerlArray a = s.split(_T("m!!")); CPerlScalar s2 = a[1]; AfxMessageBox(LPCTSTR(s2)); // pops up "b" s2 = 123; AfxMessageBox(LPCTSTR(s2)); // pops up "123" AfxMessageBox(LPCTSTR(a[1])); // pops up "123" now a.Add(_T("d")); a.Add(_T("e")); a.Add(_T("f")); a.unshift(a); // unshift self ... // this will copy 3.141 onto s s = interp.Eval(script2, _T("print qq(%s ), %d; %.03f"), _T("it's pracical to use, since it's vararg"), 123, 3.14159f); // compile script 2 to bytecode script2.ChangeType(Bytecode); // save it script2.SaveToFile(_T("TestScript.plc"); interp1.Unload(); interp2.Unload(); PXUninitializeRedirect();
故事 (重载)
我不会再给你讲那个关于语言“三人行”的故事了。(如果你不知道，一点想象力或许能帮你 :) ) (不行？好的……提示：我，Perl 和 C++) (觉得不好？没关系，继续读吧 :P。)
我一年多前发布了PXPerl，并取得了不错的成功。为什么？因为嵌入Perl非常实用。有了Perl，可以非常容易地快速开发应用程序。Perl可以轻松地完成许多用C++需要花费大量时间和精力编写和调试才能实现的任务，而且不能保证显著的速度提升。
因此，我决定编写一个更强大、更全面的新版本。同时，也更加面向对象，并且线程安全。例如，我想能够在线程中修改一个标量
- 而不导致崩溃(...)
- 并且该修改会影响到所有线程的解释器。
另外，我想从我的Perl脚本中访问我的C++函数。哦，我还想要一个真正的标准流重定向。愿望清单不止于此……我充满了新想法 :P
这被证明是非常雄心勃勃的(我不是计算机科学专业的学生，我应该没有那么多时间花在这上面……)，但我做到了。在开发它的过程中，我从Perl和Perl嵌入中学到了很多。
在开发过程中，我决定创建自己的Perl发行版。首先，出于实用原因：不想让用户烦恼于“在以下目录安装SWIG。用记事本打开XXX。等等等等”。这个Perl发行版预装了一堆模块，其中包括GraphicsMagick，一个强大的图像处理库。它被编译以获得最佳性能，平均速度比ActivePerl快16%。它的设计旨在简化开发人员的任务：带有语法高亮显示的HTML文档、Explorer集成以及捆绑的SciTE用于可视化Perl脚本编辑。
所以最终，我决定更改包装器的名称，将Perl发行版命名为PXPerl，将包装器/嵌入解决方案命名为PXPerlWrap。
PXPerlWrap包含在PXPerl中，而这个一体化包可以在我的网站上找到。
简而言之
毫不费力地嵌入一个广泛使用的脚本语言：在几分钟内享受Perl的强大功能。在几秒钟内编写高质量的应用程序。轻松维护它们。为您的应用程序增加脚本功能，将您最终用户的可能性无限扩展。
特点
PXPerlWrap是一个双向包装器。也就是说，- 您可以从您的MFC应用程序执行Perl代码，并操作变量等。
- 新增！您可以从您的Perl脚本中调用您的应用程序、C/++函数和类。
第一种方向由PXPerlWrap实现。第二种方向由SWIG实现，SWIG是一个免费的多种语言包装器，您可以在这里找到它的信息。
PXPerlWrap是一个命名空间，包含一套直观的类，并且是多线程安全的。CPerlInterpreter：表示一个Perl解释器，可以是持久化的，也可以不是。可以加载多个不同的解释器。- 解析脚本；
- 多次运行脚本；
- 获取一个变量对象来操作它或仅仅检索它的值；
- 快速
eval一段Perl代码。
CScript：一个脚本对象。每个脚本都会记录其在每个解释器下的自身属性。- 加载纯文本脚本或Perl字节码；
- 从各种来源加载：内联、文件、URL、资源；
- 保存到文件；
- 将脚本编译成字节码；
- 测试脚本；
- 重新格式化脚本；
- 设置其
ARGV。
CPerlScalar：接口一个Perl标量变量。- 字符串、整数、浮点数的赋值和算术运算，就像
s = "hello"、s /= 1和s += 1.0f一样简单，就像Perl支持的那样。 - 将它
split成一个CPerlArray； - 手动处理UTF8。
- 字符串、整数、浮点数的赋值和算术运算，就像
CPerlArray：接口一个Perl数组变量。- 常见的
CStringArray操作； push、unshift、反向unshift、反向push，可以是CPerlArray对象、CStringArray，或者来自vararg的多个元素；- 将其
join成一个CPerlScalar。
- 常见的
CPerlHash：接口一个Perl哈希变量。- 常见的
CMapStringToString操作； - Perl的
each、keys和values。
- 常见的
stdout和stderr标准流可以被重定向并发送到一个窗口。PXPerlWrap支持UTF8编码的Perl字符串，并在Unicode构建中提供各种自动字符串转换策略。- 通过设置脚本轻松安装到您现有的项目中。
您说持久化解释器？
持久化解释器的想法源自perlembed。它包括一次解析脚本（参见持久化解释器背后了解此脚本），该脚本将负责解析和运行其他脚本。每个脚本都被分配了不同的包名。这样，清理与脚本关联的包就会清理脚本使用的变量，并有望释放与之相关的内存。
持久化解释器的主要好处是能够清理脚本的命名空间，从而为其他脚本释放内存。我还没有对其进行任何基准测试，但我认为与非持久化解释器相比，速度上没有真正的提升：加载解释器稍微慢一些（实际上，是解析持久化脚本），但解析脚本可能稍微快一些。运行脚本应该是一样的。
因此，当您有一个长期运行的应用程序时，即一个长时间运行的解释器，您应该优先使用持久化解释器，这样您可以逐步清理不再需要的脚本。
公共方法
我使用了优秀的Doxygen来生成HTML格式的PXPerlWrap文档。以下是相关的头文件部分。
全局变量
///////////////// UTF8 /** @enum UTF8Mode Modes for PXSetUTF8(). Applies only to Unicode builds. */ typedef enum { UTF8_off = 0, /**< "No" conversion is made (strings are converted * to MBCS then passed to Perl). */ UTF8_on, /**< All strings are converted to UTF8 in Perl. */ UTF8_auto /**< If overwriting the value of an existing Perl scalar, check if it is an UTF8 encoded one, and in this case convert the string to UTF8. Otherwise, same behaviour as UTF8_off. */ } UTF8Mode; /** * Sets the PXPerlWrap behaviour regarding C++ strings * to Perl strings conversion. * This doesn't affect Perl to C++ conversion: * all UTF8 encoded Perl strings will * be converted to wide strings, i.e. Unicode ones; * in MBCS build, an additional * conversion is made to pass from Unicode to MBCS string (ATL CW2A macro). * @param mode UTF8 mode. In MBCS builds this cannot be changed from UTF8_off. * @return the actual changed mode; in MBCS builds, will be always UTF8_off. * @see UTF8Mode for an explanation on the different modes available. */ PXPERL_API UTF8Mode PXSetUTF8(UTF8Mode mode=UTF8_on); ///////////////// Redirection /** @def WM_PXPERL_OUTPUT The default window message for redirection */ #define WM_PXPERL_OUTPUT (WM_USER+0x85) /** @def PXPERL_STDOUT Indicates if a redirection message is standard output (wParam) */ #define PXPERL_STDOUT 1 /** @def PXPERL_STDERR Indicates if a redirection message is standard errors (wParam) */ #define PXPERL_STDERR 2 /** * Initializes standard streams redirection, * i.e. roughly open pipes, take the stdout and * stderr handles and do the necessary dup2 etc. * tricks to have streams redirected. * @param hWnd Destination window for messages * @param nRedirectMessage Message. wParam will * be either PXPERL_STDOUT or PXPERL_STDERR depending * on where the content comes from, lParam must be cast * to a LPCSTR (i.e. const char*) and is a stream * content chunk. * @warning Your message handler must be multithread-safe. * @return true on success, false otherwise. */ PXPERL_API bool PXInitializeRedirect(HWND hWnd, UINT nRedirectMessage=WM_PXPERL_OUTPUT); /** * Stops redirection, stopping pipe reading threads. */ PXPERL_API void PXUninitializeRedirect(void);
CPerlInterpreter
/** Function typedef for the xs_init Perl proc so you can customize Perl boot when loading an interpreter */ typedef void (*XS_INIT_PROC)(LPVOID); /** Function typedef for the customizable error handling function */ typedef void (*PXPERL_ERROR_PROC)(LPCTSTR); /** @class CPerlInterpreter * Represents an interpreter. All interpreter are independent, * and all Perl variable objects refer to a single interpreter. * Besides, each script is parsed/run for a single interpreter. */ class PXPERL_API CPerlInterpreter { friend class CPerlVariable; public: /** * Constructs a Perl interpreter. Does not actually load it * (yeah that's not pure OO code :P). * I find this more practical, as you may want to reload an interpreter. * @see CPerlInterpreter::Load() */ CPerlInterpreter(); /** * Destruction. Nothing special done. */ ~CPerlInterpreter(); /** * Parses a script. * @param script A script object. * @return true if script is already parsed, or was parsed successfuly. * False if the script is not valid (not correctly loaded), * or if the parse failed. */ bool Parse(CScript& script); /** * Runs a script. * @param script A script object. * @return true if script was run successfuly. False if script * is not parsed for the current interpreter, or if the run failed. */ bool Run(CScript& script); /** * Cleans a script, freeing associated variables. * @warning Applies only to a persistent interpreter. * @param script A script object. * @return true if script was cleaned successfuly. False if script * is not parsed for the current interpreter, or if the clean failed. */ bool Clean(CScript& script); /** * Evaluates a Perl snippet. The script must have been loaded, * and parsed only if the interpreter is persistent. * @param script A script object. * @param szEval The Perl code to be evaluated. * @param ... Variable arguments. * @return a scalar object, containing result of the Perl eval. * For example, if you do eval "$foo = 'bar'; $abc = join('', 'abc');", * the eval result is the value of $abc. If the evaluation * is unsuccessful, an invalid CPerlScalar is returned. * @see CPerlVariable::IsValid() */ CPerlScalar Eval(CScript& script, LPCTSTR szEval, ...); /** * Get a scalar from a script. Scalar can exist * or not. If it doesn't, it will be created. * @param script A script object. * @param szVariable The variable name. * @return a scalar object. On failure, * an invalid CPerlScalar is returned. * @see CPerlVariable::IsValid() */ CPerlScalar GetScalar(CScript& script, LPCTSTR szVariable); /** * Get an array from a script. Array can exist * or not. If it doesn't, it will be created. * @param script A script object. * @param szVariable The variable name. * @return a scalar object. On failure, an invalid CPerlArray is returned. * @see CPerlVariable::IsValid() */ CPerlArray GetArray(CScript& script, LPCTSTR szVariable); /** * Get a hash from a script. Hash can exist or not. * If it doesn't, it will be created. * @param script A script object. * @param szVariable The variable name. * @return a scalar object. On failure, an invalid CPerlHash is returned. * @see CPerlVariable::IsValid() */ CPerlHash GetHash(CScript& script, LPCTSTR szVariable); /** * Loads the interpreter. * @param bPersistent Specify wether you want a persistent * interpreter or not. For benefits and drawbacks * of a persistent interpreter, see the CodeProject article. * @param xs_init_addr Address to a custom xs_init procedure. * If none (NULL) specified, the default one is used (not recommended, * since PXPerlWrapSetup sets up a custom procedure allowing * using SWIG and exporting functions inside Perl). * @param pxperl_critical_error_addr Address to a custom (critical) * error handler. If none is specified, * a message box pops up on critical error. * @return true if successful, false otherwise. * @todo Improve error report (sort severity, * emit a warning/error each time a function * fail w/ extended info and so on). */ bool Load(bool bPersistent=true, XS_INIT_PROC xs_init_addr=NULL, PXPERL_ERROR_PROC pxperl_critical_error_addr=NULL); /** * @return true if the interpreter is loaded, false otherwise. */ bool IsLoaded(void) const; /** * Unloads the interpreter. * @return true if successful, false otherwise. */ void Unload(void); /** * Returns a pointer to the interpreter. Cast to PerlInterpreter*. * For PXPerlWrap extension. Be careful using it. * @return a non-null pointer if interpreter is properly loaded. */ void* GetMyPerl(void); /** * @return true if the interpreter is persistent, false otherwise. */ bool IsPersistent(void) const; };
CScript
/** Script types for CScript::Load() */ typedef enum { NoType = 0, /**< Means type is not known, not actually used. */ Plain, /**< Script is plain, good'old ASCII text. */ Bytecode /**< Script is Perl bytecode. */ } ScriptType; /** Source types for CScript::Load() */ typedef enum { NoSource = 0, /**< Means there is no source, not actually used. */ Inline, /**< The source is an inline, directly supplied, script. */ File, /**< The source is a file path. */ Resource, /**< The source is a RT_PERL resource. Use MAKEINTRESOURCE(id) to get a LPCTSTR. */ URL /**< The source is an URL. */ } SourceType; /** @class CScript * A script object. Holds the script content physically (that is, * a string contains either the script file or script itself). * Holds also information about whether the script is parsed * and/or run for a particular interpreter. */ class PXPERL_API CScript { friend class CPerlInterpreter; public: /** * Constructs a script object. * @see CScript::Load() to load/reload a script. */ CScript(); /** * Destroys a script object. * Scripts cannot be unloaded, but can be reloaded. */ ~CScript(); /** * Loads a script, from various sources. Loading from an URL relies * onto API function URLDownloadToFile(). * @param szSource The source, that is, either the script itself, * or a file containing the script, or an URL, or a resource * (use MAKEINTRESOURCE in this case). * @param source Specifies source type. * @param type Specifies script type. * @return true on success, false otherwise. */ bool Load(LPCTSTR szSource, SourceType source=Inline, ScriptType type=Plain); /** * @return true if the script is loaded, false otherwise. */ bool IsLoaded(void) const; /** * Saves the current script (either text or bytecode) to a file. * @param szFile File path. * @return true on success, false otherwise. */ bool SaveToFile(LPCTSTR szFile); /** * Tests the current script. * @return true if script is parsed successfuly, false otherwise. */ bool Test(void); /** * Reformats the current script to standard output. * @return true if script is parsed * and formatted successfuly, false otherwise. */ bool Reformat(void); /** * @return the custom ARGV for the script. You can, for example, * do "script.GetARGV().Add("Arg1"); ..." */ CStringArray& GetARGV(void); /** * @return the custom options for parsing. * Overrides the PXPerl.opt options if not empty. */ CStringArray& GetCustomOpts(void); /** * Get the script as a string. If the script is bytecode, * "PLBCMSWin32-x86-multi-thread" is returned. * @param strRet A CString to receive the script. * @return the same string than passed as param. * Empty string is returned on failure. */ CString& GetScript(CString& strRet); /** * Get the script as a string. If the script is bytecode, * "PLBCMSWin32-x86-multi-thread" is returned. * @return a read-only CString object with script content. * Empty string is returned on failure. */ const CString& GetScript(void); /** * Get the script as a memory pointer. * Useful to access a bytecode script content. * @return a pointer to the script, allocated on the heap, * if successful, NULL otherwise. * Free the pointer using delete [] pointer. */ LPVOID GetScript(DWORD &dwSize); /** * @return script type. */ ScriptType GetType(void) const; /** * Change type. Only Plain -> Bytecode is supported for the moment. * Use it to compile script to bytecode. * @bug Stops redirection. * @todo Fix redirection problem. * Surely will have to modify O/B Perl modules. * @param newType The new type, only Bytecode supported. * @return true on success, false otherwise. */ bool ChangeType(ScriptType newType); /** * @param pInterp Pointer to an interpreter. * @return true if the script has been parsed * successfuly by the specified interpreter. */ bool IsParsed(CPerlInterpreter *pInterp) const; /** * @param pInterp Pointer to an interpreter. * @return true if the script has been run successfuly * (at least one time) by the specified interpreter. */ bool IsRun(CPerlInterpreter *pInterp) const; /** * @param pInterp Pointer to an interpreter. * @return a read-only CString object containing the package * name created for this script by the specified interpreter. * String may be empty if interpreter is not persistent * or if script has not been parsed so far. */ const CString& GetPersistentPackage(CPerlInterpreter *pInterp) const; };
CPerlScalar
/** @class CPerlScalar * Represents a Perl scalar. */ class PXPERL_API CPerlScalar : public CPerlVariable { friend class CPerlArray; friend class CPerlHash; friend class CPerlInterpreter; public: CPerlScalar(); /**< Constructs a CPerlScalar object, marked as invalid, since not associated with a real Perl scalar. */ /** * Constructs a scalar, cloning the passed CPerlScalar object * if this one is invalid, or copying its value if valid. * @param scalar CPerlScalar object to be copied. * @see operator=() */ CPerlScalar(const CPerlScalar &scalar); ~CPerlScalar(); /**< Destroys the object. Decrements reference count, freeing the scalar if possible. */ /** * Clones the passed the passed CPerlScalar object if this * one is invalid, or copying its value if valid. * @param scalar CPerlScalar object to be cloned/copied. * @return the CPerlScalar object passed. */ const CPerlScalar& operator= (const CPerlScalar &scalar); int length(void); /**< @return the length, in characters, or the string. */ void undef(void); /**< Clears the Perl scalar value and frees the memory asscoiated with it. */ //void clear(void); /**< Clears the Perl scalar value. */ operator int() const; /**< @return the integer value of the Perl scalar. */ int Int() const; /**< @return the integer value of the Perl scalar (explicit call). */ int operator*= (int value); /**< Implements integer multiplication. @return the result value. */ int operator/= (int value); /**< Implements integer division. @return the result value. */ int operator+= (int value); /**< Implements integer addition. @return the result value. */ int operator-= (int value); /**< Implements integer substraction. @return the result value. */ int operator= (int value); /**< Implements integer assignment. @return the new value. */ operator double() const; /**< @return the float value of the Perl scalar. */ double Double() const; /**< @return the float value of the Perl scalar. */ double operator*= (double value); /**< Implements float multiplication. @return the result value. */ double operator/= (double value); /**< Implements float division. @return the result value. */ double operator+= (double value); /**< Implements float addition. @return the result value. */ double operator-= (double value); /**< Implements float substraction. @return the result value. */ double operator= (double value); /**< Implements float assignment. @return the new value. */ operator LPCTSTR() const; /**< @return the string value of the Perl scalar. */ /** * @param strRet String to receive * the string value of the Perl scalar. * @return the passed string. */ CString& String(CString& strRet) const; const CString& operator= (const CString& value); /**< Implements string assignment. @return the new value, a read-only CString object. */ LPCTSTR operator= (LPCTSTR value); /**< Implements string assignment. @return the new value, a read-only string. */ /** Implements string concatenation. * @return the result string, read-only. */ LPCTSTR operator+= (LPCTSTR value); /** * @return true if the scalar is true * as Perl means it. False otherwise. */ bool IsTrue() const; /** * @return true if the scalar native type for Perl is integer. */ bool IsInt() const; /** * @return true if the scalar native type for Perl is float. */ bool IsDouble() const; /** * @return true if the scalar native type for Perl is string. */ bool IsString() const; /** * @return true if the scalar is UTF8 encoded. */ bool IsUTF8() const; /** * The extra Perl-like function. However, there is no "sv_split" * function exported by Perl. Therefore, calling this function * is roughly the same as calling Eval("split...") in terms * of performance but is more convenient. * @param szPattern The split pattern (eg. "m!!" or "/[abc]{2}/i"). * @return a valid CPerlArray object upon success. * @see CPerlArray::join() */ CPerlArray split(LPCTSTR szPattern); void UTF8CheckSetFlag(); /**< If UTF8 flag is not set, performs a check on bytes to determine if the string is likely to be UTF8 encoded. Set the UTF8 flag in this case. */ void UTF8SetForceFlag(bool bIsUTF8=true); /**< Force the UTF8 flag to be set or not. @param bIsUTF8 true to set the flag, false otherwise. @warning This function is intended for advanced users, since it lets you deal with UTF8 manually. */ void UTF8Upgrade(); /**< Upgrades the Perl string to UTF8 encoding. Calls the Perl sv_utf8_upgrade() function. @warning This function is intended for advanced users, since it lets you deal with UTF8 manually. */ void UTF8Downgrade(); /**< Downgrade the Perl string from UTF8 encoding. Calls the Perl sv_utf8_downgrade() function. @warning This function is intended for advanced users, since it lets you deal with UTF8 manually. */ char* GetPV(); /**< @return the string value of the Perl scalar, as SvPV() Perl function returns. No conversion is made. @warning This function is intended for advanced users. Be careful of what you do with the returned pointer; a misuse will result in a crash. */ };
CPerlArray
/** @class CPerlArray * Represents a Perl array. * @warning Although methods are optimized, array operations * can be lengthy. Therefore, even if class usage is rather simple, * be careful not making redundant code. */ class PXPERL_API CPerlArray : public CPerlVariable { public: CPerlArray(); /**< Constructs a CPerlArray object, marked as invalid, since not associated with a real Perl array. */ /** * Constructs a CPerlArray object, cloning the passed CPerlArray * object if this one is invalid, or copying its values if valid. * @param array CPerlArray object to be copied. * @see operator=() */ CPerlArray(const CPerlArray &array); ~CPerlArray(); /**< Destroys the object. Nothing is done concerning the Perl array itself. */ /** * Clones the passed the passed CPerlArray object if this * one is invalid, or copies its value if valid. * @param array CPerlArray object to be cloned/copied. * @return the CPerlArray object passed. */ const CPerlArray& operator= (const CPerlArray& array); /** * Populates a CStringArray with the Perl array values. * Values can be appended to the existing CStringArray passed. * @param strARet CStringArray to receive the values. * @param bAppend true to append values * to the passed array, false otherwise. * @return the CStringArray object passed. */ CStringArray& StringArray(CStringArray &strARet, bool bAppend=false) const; /** * Copies passed CStringArray values onto Perl array, * overwriting any existing value, * and resizing the Perl array as necessary. * @param array CStringArray to be copied. * @return the CStringArray object passed. */ const CStringArray& operator= (const CStringArray& array); /** * Appends the CPerlArray's associated array * values to the current Perl array. * @param array CPerlArray to be appended. * @return the new index for the last array element, -1 on failure. */ int operator+= (const CPerlArray& array); /** * @see Append() */ int operator+= (const CStringArray& array); /** * @see Add() */ int operator+= (LPCTSTR element); /** * @see GetAt() */ CPerlScalar operator[](int nIndex); /** * Returns the value of element at the given index. * @warning If the result scalar is cloned, then modifying * it will also modify the array element (interesting behaviour!). * BUT, if the result scalar is copied, this will not modify * the array. Example: "CPerlScalar newscalar = a.GetAt(0);" => you'll * be able to modify the array element; * "CPerlScalar s = interp.GetScalar(...); s = a.GetAt(0);" => you won't. * @param nIndex Item index. * @return a valid CPerlScalar object upon success. */ CPerlScalar GetAt(int nIndex); /** * @return the size of the array, -1 on failure. */ int GetSize() const; /** * @see GetSize() */ int GetCount() const; /** * @return true if array is empty, false otherwise. */ bool IsEmpty() const; /** * @return the last element index. */ int GetUpperBound() const; /** * Extends the array to desired size. Use it prior * to adding several elements using Add(). * @param nNewSize New size. If nNewSize is smaller than * array actual size, overheading elements will be lost. */ void SetSize(int nNewSize); /** * Clears the array. Does not free memory. * @see undef() */ void RemoveAll(); void SetAt(int nIndex, LPCTSTR newElement); const CString& ElementAt(int nIndex) const; void SetAtGrow(int nIndex, LPCTSTR newElement); /** * Appends a single item to the current Perl array. * @param newElement String to be appended. * @return the new index for the last array element. */ int Add(LPCTSTR newElement); int Add(const CString& newElement); /** * Appends the CStringArray values to the current Perl array. * @param newArray CStringArray to be appended. * @return the new index for the last array element, -1 on failure. */ int Append(const CStringArray& newArray); /** * Appends the CPerlArray values to the current Perl array. * @param newArray CPerlArray to be appended. * @return the new index for the last array element, -1 on failure. */ int Append(const CPerlArray& newArray); /** * Copies the CStringArray values onto the current Perl array. * @param newArray CStringArray to be copied. */ void Copy(const CStringArray& newArray); /** * Pops a specified number of elements from the array. * That is, remove the nCount last elements from the array. * @param nCount number of elements to pop. * @return the last pop'ed element, a valid CPerlScalar upon success. */ CPerlScalar pop(int nCount=1); /** * Pushes several elements to the array. * That is, appends several elements to the array. * @param szFirst First element to push. * @param nCount Number of other elements * to push (number of vararg arguments). * @param ... Other elements to be pushed. * @warning vararg arguments must be valid LPCTSTR pointers, * otherwise your application may crash. * @return the index of the last array element, -1 on failure. * @see Add() */ int push(LPCTSTR szFirst, int nCount=0, ...); //int push(const CStringArray& array); //int push(const CPerlArray& array); /** * Shifts several elements from the array. That is, * remove several elements from the array head. * @param nCount Number of elements to shift. * @return last element shifted, a valid CPerlScalar upon success. */ CPerlScalar shift(int nCount=1); // returns last unshift-ed /** * Unshifts several elements to the array. That is, add several * elements at the head of the array. * @param szFirst First element to unshift. * @param nCount Number of other elements * to unshift (number of vararg arguments). * @param ... Other elements to be unshifted. * @warning vararg arguments must be valid LPCTSTR pointers, * otherwise your application may crash. * @return the index of the last array element, -1 on failure. */ int unshift(LPCTSTR szFirst, int nCount=0, ...); /** * Unshifts several elements to the array. * @param array CStringArray of elements to unshift. * @return the index of the last array element, -1 on failure. */ int unshift(const CStringArray& array); /** * Unshifts several elements to the array. * @param array CPerlArray of elements to unshift. * @return the index of the last array element, -1 on failure. */ int unshift(const CPerlArray& array); /** * Pushes, in reverse order, several elements to the array. * @param array CStringArray of elements to unshift. * @return the index of the last array element, -1 on failure. */ int reverse_push(const CStringArray& array); /** * Pushes, in reverse order, several elements to the array. * @param array CPerlArray of elements to unshift. * @return the index of the last array element, -1 on failure. */ int reverse_push(const CPerlArray& array); /** * Unshifts, in reverse order, several elements to the array. * @param array CStringArray of elements to unshift. * @return the index of the last array element, -1 on failure. */ int reverse_unshift(const CStringArray& array); /** * Unshifts, in reverse order, several elements to the array. * @param array CPerlArray of elements to unshift. * @return the index of the last array element, -1 on failure. */ int reverse_unshift(const CPerlArray& array); void undef(void); /**< Removes all the elements and frees the memory asscoiated with them. */ void clear(void); /**< Removes all the elements. */ /** * The extra Perl-like function. However, there is no "sv_join" * function exported by Perl. Therefore, calling this function * is roughly the same as calling Eval("join...") in terms * of performance but is more convenient. * @param szGlue The joining glue. * @return a valid CPerlScalar object upon success. * @see CPerlScalar::split() */ CPerlScalar join(LPCTSTR szGlue); };
CPerlHash
/** @class CPerlHash * Represents a Perl hash. */ class PXPERL_API CPerlHash : public CPerlVariable { public: CPerlHash(); /**< Constructs a CPerlHash object, marked as invalid, since not associated with a real Perl hash. */ /** * Populates a CMapStringToString with the Perl hash keys. * Keys can be appended to the existing CMapStringToString passed. * @param mapRet CMapStringToString to receive the keys. * @param bAppend true to append values * to the passed hash, false otherwise. * @return the CMapStringToString object passed. */ CMapStringToString& MapStringToString(CMapStringToString &mapRet, bool bAppend=false); /** * Copies passed CStringArray keys onto Perl hash, * overwriting any existing key. * @param map CMapStringToString to be copied. * @return the CMapStringToString object passed. */ const CMapStringToString& operator= (const CMapStringToString& map); /** * Clones the passed the passed CPerlHash object if this * one is invalid, or copies its keys if valid. * @param hash CPerlHash object to be cloned/copied. * @return the CPerlHash object passed. */ const CPerlHash& operator= (const CPerlHash& hash); /** * @return the number of keys of the hash. */ int GetCount() const; /** * @return the number of keys of the hash. */ int GetSize() const; /** * @return true if the hash is empty, false otherwise. */ bool IsEmpty() const; /** * Look up for a key in the hash. * @param key The key to look up for. * @param rValue A CString to receive the value associated * with the key. If key if not found, rValue is not modified. * @return true if the key was found, false otherwise. */ bool Lookup(LPCTSTR key, CString& rValue) const; /** * Look up for a key in the hash. * @param key The key to look up for. * @return a valid CPerlScalar upon success. * @see CPerlArray::GetAt() for the same remark * about the CPerlScalar object returned. */ CPerlScalar Lookup(LPCTSTR key) const; /** * @see Lookup() */ CPerlScalar operator[](LPCTSTR key) const; /** * Adds (or modifies) a key to the hash. * @param key Key. * @param newValue Value. */ void SetAt(LPCTSTR key, LPCTSTR newValue); /** * Removes specified key. * @param key Key. * @return true if key is found and deleted * successfuly, false otherwise. */ bool RemoveKey(LPCTSTR key); /** * Removes all keys from the hash. * @see clear() */ void RemoveAll(); /** * Iterates through the hash the same way Perl's each function do. * Each call returns next key/value pair, * in an unpredictable order, but always the same order. * @param strKey Next key encountered in the hash. * @param strValue Value associated with the key. * @return true as long as all the keys * have not been enumerated, false on end. */ bool each(CString &strKey, CString &strValue); /** * Returns the hash keys the same way Perl's keys function do. * @warning Calling this function resets the iterator, * so next call to each() will return the first key/value pair. * @param strARet CStringArray to receive the keys. * @return the passed CStringArray. */ CStringArray& keys(CStringArray &strARet); /** * Returns the hash values the same way Perl's values function do. * @warning Calling this function resets the iterator, * so next call to each() will return the first key/value pair. * @param strARet CStringArray to receive the values. * @return the passed CStringArray. */ CStringArray& values(CStringArray &strARet); /** * Tells if a key exists. * @param key Key. * @return true if key exists, false otherwise. */ bool exists(LPCTSTR key); void undef(void); /**< Removes all the key/value pairs and frees the memory asscoiated with them. */ void clear(void); /**< Removes all the key/value pairs. */ };
代码片段
这里是PXPerlWrap中使用的一些代码片段，它们很有趣，可能对您有用。
如何重定向标准流而不生成进程
开发PXPerlWrap的这部分花了我很多时间。为什么？因为我在错误的地方寻找bug。我卡了好几个小时，却无法弄清楚为什么在调试模式下，标准流要么根本没有被重定向，要么只被部分重定向。事实上，这可能对在座的某些人来说很明显，但当时对我来说不是，问题出在Perl DLL上，它链接了一个与PXPerlWrap调试DLL（MSVCR71D.DLL）不同的CRT DLL（MSVCR71.DLL）。因此，输出和错误文件描述符是不一样的。想要重定向它们是徒劳的。这就是为什么我必须提供一个Perl调试DLL。
下面代码的大部分功劳直接归功于Vladimir Schneider。他还为我提供了极大的帮助，使重定向工作正常。谢谢！
//// bool PXInitializeRedirect(HWND hWnd /*destination window for messages*/, UINT nRedirectMessage); void PXUninitializeRedirect(void); //// // static, process-wide variables static HANDLE s_hThreadStdOut=NULL, s_hThreadStdErr=NULL, s_hThreadDispatch=NULL, s_hEvent=NULL; static int s_handlesStdOut[2] = { -1, -1}; static int s_handlesStdErr[2] = { -1, -1}; static bool s_bRedirecting = false; // the pipes size // also used for buffer size #define REDIR_BUFSIZE 4096 // The structure which is passed to threads upon their creation typedef struct sThreadData { HWND hWnd; int hReadPipe; UINT nMsg; WPARAM nMsgWParam; } ThreadData; // threaded procedure static UINT __stdcall RedirectProc(void *pData) { ThreadData td; int nBytesRead; char *buffer; // choose always a char* even under Unicode, // to avoid dubious conversions // make a copy of the thread info which is not static memcpy(&td, pData, sizeof(ThreadData)); // signal the mother thread we are done with copying the thread data SetEvent(s_hEvent); // the buffer which receive data from read pipe // and is passed to destination window buffer = new char[REDIR_BUFSIZE]; // begin the read/send loop while (s_bRedirecting) { if ((nBytesRead = _read(td.hReadPipe, buffer, REDIR_BUFSIZE)) < 1) { // if an error occurs while reading // the pipe or nothing to read, we'll get here if (!s_bRedirecting || errno) break; Sleep(20); continue; } buffer[nBytesRead] = 0; //TRACE("[PXPW] RedirectThread(%d): %d bytes sent\n", // td.nMsgWParam, nBytesRead); // if we are asked to stop or window is invalid, break if (!s_bRedirecting || !::IsWindow(td.hWnd)) break; // Send data ::SendMessage(td.hWnd, td.nMsg, td.nMsgWParam, (LPARAM)buffer); } // free memory delete [] buffer; TRACE("[PXPW] RedirectThread(%d): deleted buffer\n", td.nMsgWParam); // signal we ended _endthreadex(0); return 0; } bool PXInitializeRedirect(HWND hWnd, UINT nRedirectMessage) { // stop any previous redirection PXUninitializeRedirect(); UINT thread_id; ThreadData td; FILE *fp = NULL; STARTUPINFO si; si.cb = sizeof(STARTUPINFO); GetStartupInfo(&si); // create an event used for threads initialization s_hEvent = CreateEvent(NULL, FALSE, FALSE, NULL); // create pipes // for output if (_pipe(s_handlesStdOut, REDIR_BUFSIZE, _O_TEXT | _O_NOINHERIT) == -1) goto _redirect_failure; // for errors if (_pipe(s_handlesStdErr, REDIR_BUFSIZE, _O_TEXT | _O_NOINHERIT) == -1) goto _redirect_failure; // close the existing output and errors file descriptors _close(1); // output _close(2); // errors // reassign the output and errors file descriptors if (-1 == _dup2(s_handlesStdOut[1], 1)) goto _redirect_failure; if (-1 == _dup2(s_handlesStdErr[1], 2)) goto _redirect_failure; // close the write file descriptors of the pipes, // which we don't need anymore // (we only need to read now) _close(s_handlesStdOut[1]); _close(s_handlesStdErr[1]); s_handlesStdOut[1] = -1; s_handlesStdErr[1] = -1; // this is not really needed, we just make sure the standard // console output and errors handles of our application are the same as if (si.hStdOutput != (HANDLE)-1) SetStdHandle(STD_OUTPUT_HANDLE, si.hStdOutput); if (si.hStdError != (HANDLE)-1) SetStdHandle(STD_ERROR_HANDLE, si.hStdError); // let's start the threads now... s_bRedirecting = true; // fill the thread info struct td.hWnd = hWnd; td.nMsg = nRedirectMessage; td.nMsgWParam = PXPERL_STDOUT; td.hReadPipe = s_handlesStdOut[0]; // start the first one s_hThreadStdOut = (HANDLE)_beginthreadex(NULL, 0, RedirectProc, (void*)&td, 1, &thread_id); if (!s_hThreadStdOut) goto _redirect_failure; // wait for signal thread finished initialization WaitForSingleObject(s_hEvent, INFINITE); // the same for the second td.nMsgWParam = PXPERL_STDERR; td.hReadPipe = s_handlesStdErr[0]; s_hThreadStdErr = (HANDLE)_beginthreadex(NULL, 0, RedirectProc, (void*)&td, 1, &thread_id); if (!s_hThreadStdErr) goto _redirect_failure; WaitForSingleObject(s_hEvent, INFINITE); // important: reset the stdout and stderr structs for current process, // so not only low level IO access function // are being redirected, but also // printf() and so on. fp = _fdopen(1, "w"); setvbuf(fp, NULL, _IONBF, 0); memcpy(stdout, fp, sizeof(FILE)); //memcpy(win32_stdout(), fp, sizeof(FILE)); fp = _fdopen(2, "w"); setvbuf(fp, NULL, _IONBF, 0); memcpy(stderr, fp, sizeof(FILE)); //memcpy(win32_stderr(), fp, sizeof(FILE)); return true; _redirect_failure: // failure, close handles still open PXUninitializeRedirect(); return false; } void PXUninitializeRedirect(void) { if (s_bRedirecting) { // send something to the pipe, so the threads leave the _read(...) // and can test if they must quit s_bRedirecting = false; char eos[] = "\n"; _write(1, eos, sizeof(eos)); _write(2, eos, sizeof(eos)); // let them a slice to leave their loop Sleep(20); } // then, close handles and set them to NULL if (s_hThreadStdOut) { WaitForSingleObject(s_hThreadStdOut, 1000); CloseHandle(s_hThreadStdOut); s_hThreadStdOut = NULL; } if (s_hThreadStdErr) { WaitForSingleObject(s_hThreadStdErr, 1000); CloseHandle(s_hThreadStdErr); s_hThreadStdErr = NULL; } if (s_hEvent) CloseHandle(s_hEvent); s_hEvent = NULL; if (s_handlesStdOut[0] != -1) _close(s_handlesStdOut[0]); if (s_handlesStdOut[1] != -1) _close(s_handlesStdOut[1]); if (s_handlesStdErr[0] != -1) _close(s_handlesStdErr[0]); if (s_handlesStdErr[1] != -1) _close(s_handlesStdErr[1]); s_handlesStdOut[0] = -1; s_handlesStdOut[1] = -1; s_handlesStdErr[0] = -1; s_handlesStdErr[1] = -1; }
持久化解释器背后
为了维护持久化解释器，我们需要一个脚本（我称之为perlsistent.pl）来解析和运行“子脚本”，并清理它们。在perlembed中建议了这样一个脚本。我为PXPerlWrap对其进行了一些修改。以下是代码：
# Perl Persistent Interpreter. Core Script File. # From perlembed, modified by PixiGreg. ################################################# my $verbose = 0; # this was for testing purposes our %Cache; # the package names cache BEGIN { # disable stdout/stderr buffering $|++; select STDERR; $|++; select STDOUT; use strict; use warnings 'all'; use Symbol qw(delete_package); } # routine used to parse a sub-script sub parse { my($packagename, $script, $empty) = @_; $verbose and print STDERR "[Perlsistent] compiling $packagename\n"; # clean if a script is already compiled with same name defined $Cache{$packagename} and delete_package($packagename), undef $Cache{$packagename}; # wrap the code into a subroutine inside our unique package my $eval = qq{package $packagename; sub handler { $script; }}; { # hide our variables within this block my($packagename, $script); eval $eval; } # tell this package contains a valid executable routine $Cache{$packagename} = 1; return 1; } # routine used to run a sub-script sub run { my($packagename, $empty) = @_; $verbose and print STDERR "[Perlsistent] running $packagename\n"; if ($Cache{$packagename} == 1) { $packagename->handler(); } return 1; } # routine used to clean a sub-script sub clean { my $packagename = shift; $verbose and print STDERR "[Perlsistent] cleaning $packagename\n"; defined $Cache{$packagename} and delete_package($packagename), undef $Cache{$packagename}; } 1;
在您的项目中设置PXPerlWrap
通过提供的设置脚本，将PXPerlWrap安装到您的项目中变得非常简单。以下是将PXPerlWrap安装到您的项目中的步骤（也包含在PXPerl文档中）：
- 将您的项目二进制输出目录设置为一个单一的、唯一的目录，针对所有配置，如果尚未如此。同时修改输出文件名。
示例
配置输出文件名Debugbin/MyApp-d.exeReleasebin/MyApp.exe调试 Unicodebin/MyApp-ud.exe发布 Unicodebin/MyApp-u.exe
这样，您就不必拥有多个副本的PXPerlWrap.dll、Perl58.dll和Perl默认模块，即每个输出目录一个。
- 转到PXPerl安装目录。
运行"Step 1 - Edit PXPerlWrapSetup config file.bat"。
您需要修改几个变量才能将
PXPerlWrap安装到您的项目中；这在配置文件中有详细说明。
- 运行"Step 2 - Launch PXPerlWrapSetup.bat"。
设置脚本将在您的项目目录中为您创建几个文件（即：pxpw_*.bat、PXPerlWrap目录、输出目录下的DLL文件以及模块目录）。
在此过程中，您不应看到任何错误。否则，您可能指定了错误的路径或选项。返回步骤2仔细阅读。如果问题仍然存在，请向我报告。
- 将“PXPerlWrap.h”和“PXPerlWrap.cpp”文件添加到您的项目中（位于您项目目录中的PXPerlWrap目录中）；仅添加这些文件。
更正：您还可以添加export.h，以便于访问，有关此文件的目的，请参见步骤8。
- 在您的项目设置中，为每个配置添加一个预构建事件和一个后构建事件。配置预构建事件后构建事件调试（Unicode或非Unicode）PXPW_prebuild.batPXPW_postbuild_debug.bat发布（Unicode或非Unicode）PXPW_prebuild.batPXPW_postbuild.bat
- 对于每个配置，添加附加包含目录“$(PXPERL)\lib\CORE”。
- 现在，无论您想在哪里使用
PXPerlWrap类，只需在程序的头文件中添加此内容：#include "PXPerlWrap/PXPerlWrap.h"
- 您希望通过SWIG导出的函数的原型（即对您的脚本可用）必须出现在“export.h”中。
就是这样：)
常见问题
问：可恶，源代码不可用！
答：我必须承认，在决定不提供整个PXPerlWrap源代码之前，我曾三思而后行。是的，尽管我鼓励开源项目，但这仍然是一个个人选择。然而，您可以在我的网站上购买PXPerlWrap的完整源代码。
不过，我公开了一些代码片段，因为它们可能对社区有用。请参阅代码片段。
问：PXPerlWrap是免费的还是不免费的？
答：基本上是的。PXPerlWrap可以免费用于免费软件等。任何商业用途都需要商业许可证，详情请参见我的网站。PXPerl Perl发行版本身，除了PXPerlWrap和其他附带各自许可的捆绑软件外，也遵循与Perl相同的许可，即艺术许可证。
问：为什么PXPerlWrap要用这么大的包PXPerl来发布？PXPerlWrap需要16MB吗？我的应用程序需要附带16MB吗？
答：PXPerlWrap需要PXPerl，即Perl发行版，以方便使用。我认为一体化包装更实用。另一个原因是PXPerl和PXPerlWrap紧密链接，后者通过设置脚本需要前者。
而且，不，您的应用程序在使用PXPerlWrap时不会有16MB的开销。通过不错的压缩，并且只嵌入标准模块，您将大约占用2MB。
问：那么，最终用户不需要在他的机器上安装PXPerl或任何其他Perl二进制发行版了吗？
答：是的，就是这样。
提供PXPerlWrap*.dll（*取决于您向最终用户提供的构建版本，Unicode或MBCS）、perl58.dll、PXPerl.opt以及您在设置期间指定的模块目录就足够了。只需保留此文件树即可。
问：当我向PXPerlWrap提供相对路径时，会发生什么？
答：PXPerlWrap会将这些路径转换为绝对路径，但不是指向活动目录，而是指向PXPerlWrap DLL。我必须这样做，因为在调试时，Visual Studio会设置一个不明显的活动目录，即项目目录。因此，在加载脚本文件时要小心。
问：我构建了应用程序的Release [Unicode]版本，测试了它，它正常工作。然后我编译了Debug [Unicode]版本，而release可执行文件不再工作/卡死！
答：这是因为您的release可执行文件需要release Perl DLL，而您的debug版本需要Perl debug DLL。两个DLL名称相同。为什么？因为这样，我就不必为debug DLL提供所有已编译的模块。为什么需要Perl debug DLL？因为否则您的应用程序debug可执行文件和Perl release DLL将链接到不同的CRT DLL，一个是debug的，另一个不是，而重定向将不起作用。
问：哇，这个DLL太大了！
答：是的，有时你必须在速度和大小之间做出选择，我更喜欢速度。使用UPX打包器可以显著减小DLL的大小（特别是perl58.dll，2.4MB）。
问：我想将所有这些DLL静态链接。可能吗？
答：不。Perl无法安全地静态链接。没有计划制作静态PXPerlWrap。
历史
- 2004年11月1日：v2.02：重要的更改和错误修复。
- 文档和新的CodeProject文章！
- 修复了标量引用计数警告。实际上，我在上一个版本中没有管理标量引用计数……
- 修复了调用
PXUninitializeRedirect()时出现的2秒延迟问题。 - 修复了未删除的临时文件。
- 修复了PXPerlWrapSetup中错误的调试Perl DLL导入库路径，该路径导致了调试构建链接阶段的错误。
- 将
CPerlVariable::Destroy()设为公共，以便您可以重用变量对象。 - 修复了
CPerlArray::push/unshift和CPerlHash::Lookup()中的一些bug。
- 2004年10月27日：v2.01：完全重写。大量新功能。新名称：
PXPerlWrap，属于PXPerl包。 - 2003年7月14日：v1.2：支持哈希！移除了Unicode编译支持。更新了文章。
- 2003年7月13日：v1.1：现在使用
PerlIO::scalar，并且没有实际文件来存储STD*输出。更快。 - 2003年7月12日：首次发布（v1.0）。未公开发布。
待续
更全面的描述/教程，关于PXPerlWrap在Unicode构建中对UTF8编码字符串的处理。