PXPerlWrap (PXPerl, reloaded)

// PXPerl.cpp: implementation of the CPerl class.
//
//////////////////////////////////////////////////////////////////////

#include "stdafx.h"
#include "PXPerl.h"
#include "resource.h"

#pragma comment(lib, "shlwapi.lib")
#pragma comment(lib, "PERL_CORE/perl58.lib")

#ifdef DEBUG
#define POP_DEBUG
#pragma push_macro("DEBUG")
#undef DEBUG
#endif

#include "PERL_CORE/config.h"
#include "PERL_CORE/EXTERN.h"
#include "PERL_CORE/perl.h"
#include "PERL_CORE/XSUB.h"

#ifdef POP_DEBUG
#pragma pop_macro("DEBUG")
#endif

#undef bool
#undef Null
#undef Copy
#undef Pause
#undef Move
#undef open
#undef write
#undef read
#undef eof
#undef close
#undef IsWinNT
#undef ftell
#undef fseek
#undef free
#undef malloc

#include <io.h>
#include <fcntl.h>
#include <sys/types.h>
#include <sys/stat.h>


#pragma warning(disable : 4706) // to be compiler-warning-level-4-safe


namespace PXPerl
{

//////////////////////////////////////////////////////////////////////
// globals

LPCSTR CPerlConfigFile::g_szOutputFormat = "\n\
								 # Variable: %s | Type: %s\n\
								 # Comment: %s\n\
								 \n\
								 %s = %s;\n\
								 ";
LPCSTR CPerlConfigFile::g_szOutputFormatWithDefault = "\n\
											# Variable: %s | Type: %s | Default Value: \"%s\"\n\
											# Comment: %s\n\
											\n\
											%s = %s;\n\
											";


CStringA CPerl::g_strExeDir;

//////////////////////////////////////////////////////////////////////
// defines 

#define IS_LOADED (m_pMyPerl!=NULL)
#define IS_UNLOADED (m_pMyPerl==NULL)

#define SET_CONTEXT PERL_SET_CONTEXT((PerlInterpreter*)m_pMyPerl)

#define IS_INVALID_SOBJ(s) (s.m_nIndex < 0 || s.m_nIndex > m_nMaxPackageIndex || m_strAPackages.GetAt(s.m_nIndex).IsEmpty())

#define MAKE_SCOPE_VAR(s, var) \
	if (IS_INVALID_SOBJ(s) || !var || !*var) \
		return false; \
	char beef[256]; \
	if (var[0] == ':' && var[1] == ':') \
		strcpy(beef, var + 2); \
	else \
	{ \
		strcpy(beef, m_strAPackages.GetAt(s.m_nIndex)); \
		strcat(beef, "::"); \
		strcat(beef, var); \
	} \
	var = (const char*)beef;

#define COMMON_SET(s, var) \
	if (IS_UNLOADED) return false; \
	SET_CONTEXT; \
	MAKE_SCOPE_VAR(s, var);

#define COMMON_GET(s, var) COMMON_SET(s, var)

//////////////////////////////////////////////////////////////////////
// utility

CStringA PXGetExeDir(void)
{
	if (CPerl::g_strExeDir.IsEmpty())
	{
		TCHAR szPath[MAX_PATH];
		if (GetModuleFileName(NULL, szPath, MAX_PATH))
		{
			PathRemoveFileSpec(szPath);
			CPerl::g_strExeDir = (LPCTSTR)szPath;
		}
	}

	return CPerl::g_strExeDir;
}
/*
bool PXTestCreateFile(LPCSTR szFile, bool bUnlink=false)
{
	int fh = _open(szFile, _O_WRONLY | _O_CREAT | _O_TRUNC | _O_BINARY,
		_S_IREAD | _S_IWRITE);
	if (fh != -1)
	{
		_close(fh);
		if (bUnlink)
			_unlink(szFile);
		return true;
	}
	return false;
}
*/
void PXPathAppend(CStringA &strPath, LPCSTR szAppend)
{
	PathAppendA(strPath.GetBuffer(MAX_PATH), szAppend);
	strPath.ReleaseBuffer();
}

void PXPerlErrorMsgBox(LPCSTR szText)
{
	::MessageBoxA(AfxGetMainWnd()->GetSafeHwnd(), szText /*+ CStringA("\n\nThis error may be due to a modification of perlsistent.pl.")*/, "Perl Persistent Interpreter Error",
		MB_OK | MB_ICONSTOP);
}

LPVOID PXReadPerlResource(int nResID, DWORD &dwSize)
{
	HMODULE hModule = GetModuleHandle(NULL);
	HRSRC hRes = FindResource(hModule,
		MAKEINTRESOURCE(nResID), MAKEINTRESOURCE(RT_PERL));
	if (!hRes)
		return NULL;
	dwSize = SizeofResource(hModule, hRes);
	if (!dwSize)
		return NULL;
	HANDLE hResData = LoadResource(hModule, hRes);
	if (!hResData)
		return NULL;
	return LockResource(hResData);
}
/*
long PXGetFileSize(LPCSTR szFile)
{
	int fh;
	if ((fh=_open(szFile, _O_RDONLY)) == -1)
		return 0;
	long nFileSize = _lseek(fh, 0L, SEEK_END);
	_close(fh);
	return nFileSize;
}
*/
int PXGetFileSize(int fh)
{
	int nPrevPos = _tell(fh);
	_lseek(fh, 0, SEEK_SET);
	int size = _lseek(fh, 0, SEEK_END);
	_lseek(fh, nPrevPos, SEEK_SET);
	return size;
}

bool PXReadFile(LPCSTR szFile, CStringA &strRead)
{
	bool bRet = false;
	int fh;
	if ((fh = _open(szFile, _O_RDONLY | _O_BINARY)) == -1)
		return false;
	int size = PXGetFileSize(fh);
	if (size > 0)
	{
		LPSTR sBuffer = strRead.GetBuffer(size + 8);
		int nRead = _read(fh, (void*)sBuffer, size);
		sBuffer[size] = 0;
		strRead.ReleaseBuffer();
		bRet = (nRead == size);
	}
	_close(fh);

	return bRet;
}

bool PXWriteCreateFile(LPCSTR szFile, const CStringA &strWrite)
{
	int fh;
	if ((fh = _open(szFile, _O_WRONLY | _O_CREAT | _O_TRUNC | _O_BINARY, _S_IREAD | _S_IWRITE)) == -1)
		return false;
	int size = strWrite.GetLength(); 
	bool bRet = (_write(fh, (const void*)LPCSTR(strWrite), size) == size);
	_close(fh);
	return bRet;
}


// that's tricky void *m_pMyPerl, huh?
bool PXPerlCallRetString(void *m_pMyPerl, LPCSTR szFunc, CStringA &strRet)
{
	if (IS_LOADED)
	{
		SET_CONTEXT;

		dSP;
		bool ret = false;
        int count;
		ENTER ;
        SAVETMPS;
		PUSHMARK(SP);
        PUTBACK;
		count = call_pv(szFunc, G_EVAL | G_SCALAR);
		SPAGAIN;

		if (count != 1)
            PXPerlErrorMsgBox((LPCSTR)SvPV_nolen(ERRSV));
		else if (SvTRUE(ERRSV))
		{
			PXPerlErrorMsgBox((LPCSTR)SvPV_nolen(ERRSV));
			POPs;
		}
		else
		{
			strRet = POPp;//(LPCSTR)SvPV_nolen(POPs);
			ret = true;
		}

		PUTBACK;
        FREETMPS;
        LEAVE;

		return ret;
	}
	return false;
}

bool PXPerlCall(void *m_pMyPerl, LPCSTR szFunc)
{
	if (IS_LOADED)
	{
		char *args[] = { NULL };
	
		SET_CONTEXT;
		call_argv(szFunc, G_EVAL | G_DISCARD, args);

		if (SvTRUE(ERRSV))
		{
			PXPerlErrorMsgBox((LPCSTR)SvPV_nolen(ERRSV));
			return false;
		}
		return true;
	}
	return false;
}

//////////////////////////////////////////////////////////////////////
// Construction/Destruction
//////////////////////////////////////////////////////////////////////

CPerl::CPerl()
{
	m_pMyPerl = NULL;
	m_strAPackages.SetSize(3);
	m_nMaxPackageIndex = 0;
	m_bAutoEmpty = true;
}

CPerl::~CPerl()
{
	Unload();
}

//////////////////////////////////////////////////////////////////////

EXTERN_C void boot_DynaLoader(pTHXo_ CV* cv);

EXTERN_C void
xs_init(pTHXo)
{
	UNUSED_ALWAYS(my_perl); // compiler warning level 4... argh !

	char *file = __FILE__;
	dXSUB_SYS;

	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}

//////////////////////////////////////////////////////////////////////

bool CPerl::Load()
{
	if (IS_UNLOADED)
	{
		bool bLoaded = false;

		//////////////////////////////////////////////////////////////////
		// NOTE: if you get an assert from below, that's because
		// you missed something setting up this class in your project -

		DWORD dwSize;
		LPVOID lpData = PXReadPerlResource(IDR_PERLSISTENT, dwSize);
		if (!lpData)
			ASSERT(0);

		//////////////////////////////////////////////////////////////////

		LPSTR buffer = new CHAR[dwSize+8];
		memcpy(buffer, lpData, dwSize);
		buffer[dwSize] = 0;

		char *embedding[] = { "", "-e", buffer };

		int ret = 0;

		if ((m_pMyPerl = (void*)perl_alloc()) == NULL)
		{
			PXPerlErrorMsgBox("Could not allocate memory for Perl !");
			goto _return;
		}
		else
		{
			perl_construct((PerlInterpreter*)m_pMyPerl);

			ret = perl_parse((PerlInterpreter*)m_pMyPerl, xs_init,
				sizeof(*embedding) - 1, embedding, NULL);

			if (ret)
				goto _on_error;
			else
			{
				PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
				ret = perl_run((PerlInterpreter*)m_pMyPerl);
				if (ret)
					goto _on_error;
				else
				{
					// Make sure it's all right
					char *args[] = { NULL };
					int nCount = call_argv("test", G_EVAL | G_SCALAR, args);
					if (nCount != 1 || SvTRUE(ERRSV))
						goto _on_error;
					else
						bLoaded = true;
				}
			}
		}

		goto _return;

_on_error:
		{
			CStringA strErr("Error while running persistent interpreter ");
			if (SvTRUE(ERRSV))
			{
				strErr += ":\n\n";
				strErr += (LPCSTR)SvPV_nolen(ERRSV);
			}
			else
			{
				strErr += ".";
			}

			PXPerlErrorMsgBox(LPCSTR(strErr));

			perl_destruct((PerlInterpreter*)m_pMyPerl);
			perl_free((PerlInterpreter*)m_pMyPerl);
			m_pMyPerl = NULL;
		}

_return:
		delete [] buffer;

		return bLoaded;
	}

	return true;
}

void CPerl::Unload()
{
	if (IS_LOADED)
	{
		try
		{
			SET_CONTEXT;
			PL_perl_destruct_level = 0;
			perl_destruct((PerlInterpreter*)m_pMyPerl);
			perl_free((PerlInterpreter*)m_pMyPerl);
			m_pMyPerl = NULL;

			m_strAPackages.SetSize(0);
			m_nMaxPackageIndex = 0;
			m_strAPackages.SetSize(3);
		}
		catch (...)
		{
			TRACE("EXCEPTION: CPerl::Unload()\n");
		}
	}
}

CScript CPerl::Compile(LPCSTR szName, LPCSTR szScript)
{
	CScript script;
	
	if (IS_UNLOADED)
	{
		// Perl not loaded at this point
		return script;
	}

	// check the script name (will be used as the perl package name)
	if (!szName || !*szName || isdigit((int)*szName))
		return NULL;
	int len = (int)strlen(szName);
	for (int i=0; i<len; i++)
	{
		if (!isalnum((int)szName[i]))
			return NULL;
	}

	LPSTR sPackageName = new CHAR[len+1];
	memcpy(sPackageName, szName, len);
	sPackageName[len] = 0;

	len  = (int)strlen(szScript);
	LPSTR sScript = new CHAR[len+1];
	memcpy(sScript, szScript, len);
	sScript[len] = 0;

	char *args[] = { sPackageName, sScript, m_bAutoEmpty ? "1" : NULL, NULL };

	SET_CONTEXT;
	call_argv("compile", G_EVAL | G_DISCARD, args);
	// calling with G_EVAL : can't get script errors with ERRSV
	// calling without G_EVAL : in case of error, app crash risks, but we can grab script errors with ERRSV

	delete [] sScript;
	CStringA strPackageName((LPCSTR)sPackageName);
	delete [] sPackageName;

	if (SvTRUE(ERRSV))
	{
		PXPerlErrorMsgBox((LPCSTR)SvPV_nolen(ERRSV));
		return script;
	}

	CStringA strErr;
	if (GetSTDERR(strErr))
	{
		return script;
	}

	m_strAPackages.SetAtGrow(m_nMaxPackageIndex, strPackageName);
	script.m_nIndex = m_nMaxPackageIndex;
	m_nMaxPackageIndex++;

	return script;
}

CScript CPerl::Compile(LPCSTR szName, const CPerlConfigFile& perlConfig)
{
	return Compile(szName, LPCSTR(perlConfig.m_strOutput));
}

CScript CPerl::Compile(LPCSTR szName, int nResID)
{
	CScript script;
	DWORD dwSize;
	LPVOID lpData = PXReadPerlResource(nResID, dwSize);
	if (!lpData)
		return NULL;

	LPSTR buffer = new CHAR[dwSize+8];
	memcpy(buffer, lpData, dwSize);
	buffer[dwSize] = 0;

	script = Compile(szName, (LPCSTR)buffer);

	delete [] buffer;

	return script;
}

CScript CPerl::CompileFile(LPCSTR szName, LPCSTR szFile)
{
	CStringA strScript;
	if (!PXReadFile(szFile, strScript))
		return NULL;

	return Compile(szName, strScript);
}

bool CPerl::Exec(const CScript& script)
{
	if (IS_UNLOADED)
	{
		// Perl not loaded at this point
		return false;
	}

	if (IS_INVALID_SOBJ(script))
		return false;

	char *args[] = { m_strAPackages.GetAt(script.m_nIndex).GetBuffer(0),
		m_bAutoEmpty ? "1" : NULL, NULL };

	SET_CONTEXT;
	call_argv("execute", G_EVAL | G_DISCARD, args);

	m_strAPackages.GetAt(script.m_nIndex).ReleaseBuffer();

	if (SvTRUE(ERRSV))
	{
		PXPerlErrorMsgBox((LPCSTR)SvPV_nolen(ERRSV));
		return false;
	}

	CStringA strErr;
	if (GetSTDERR(strErr))
	{
		return false;
	}

	return true;
}

void CPerl::Clean(CScript& script)
{
	if (IS_UNLOADED)
	{
		// Perl not loaded at this point
		return;
	}

	if (IS_INVALID_SOBJ(script))
		return;

	char *args[] = { m_strAPackages.GetAt(script.m_nIndex).GetBuffer(0), NULL };
	m_strAPackages.GetAt(script.m_nIndex).ReleaseBuffer();

	SET_CONTEXT;
	call_argv("clean", G_EVAL | G_DISCARD, args);

	if (SvTRUE(ERRSV))
	{
		PXPerlErrorMsgBox((LPCSTR)SvPV_nolen(ERRSV));
		return;
	}

	m_strAPackages.GetAt(script.m_nIndex).Empty();
}

bool CPerl::DoScript(LPCSTR szScript)
{
	bool bRes = false;
	CScript script = Compile("Temp", szScript);
	if (script.IsValid())
	{
		bRes = Exec(script);
		Clean(script);
	}
	return bRes;
}

bool CPerl::DoScript(const CPerlConfigFile& perlConfig)
{
	bool bRes = false;
	CScript script = Compile("Temp", perlConfig);
	if (script.IsValid())
	{
		bRes = Exec(script);
		Clean(script);
	}
	return bRes;
}

bool CPerl::DoFile(LPCSTR szFile)
{
	bool bRes = false;
	CScript script = CompileFile("Temp", szFile);
	if (script.IsValid())
	{
		bRes = Exec(script);
		Clean(script);
	}
	return bRes;
}

bool CPerl::DoScript(int nResID)
{
	bool bRes = false;
	CScript script = Compile("Temp", nResID);
	if (script.IsValid())
	{
		bRes = Exec(script);
		Clean(script);
	}
	return bRes;
}

bool CPerl::GetSTDERR(CStringA &strContents)
{
	if (!PXPerlCallRetString(m_pMyPerl, "get_stderr", strContents))
		return false;
	return (strContents.IsEmpty()==0);
}

bool CPerl::GetSTDOUT(CStringA &strContents)
{
	if (!PXPerlCallRetString(m_pMyPerl, "get_stdout", strContents))
		return false;
	return (strContents.IsEmpty()==0);
}

void CPerl::EmptySTDERR(void)
{
	PXPerlCall(m_pMyPerl, "empty_stderr");
}

void CPerl::EmptySTDOUT(void)
{
	PXPerlCall(m_pMyPerl, "empty_stdout");
}

void CPerl::EmptyOutputs(void)
{
	PXPerlCall(m_pMyPerl, "empty_outputs");
}

bool CPerl::SetInt(const CScript& script, LPCSTR szVariable, const int value)
{
	COMMON_SET(script, szVariable);
	//<CPerlWrap>
	// Create the scalar if it doesn't exist, turn off spurious warnings
	SV *v = get_sv(szVariable, true|GV_ADDMULTI);
	if (!v) return false;
	sv_setiv(v, value);
	return true;
	//</CPerlWrap>
}

bool CPerl::GetInt(const CScript& script, LPCSTR szVariable, int &value)
{
	COMMON_SET(script, szVariable);
	//<CPerlWrap>
	SV *v = get_sv(szVariable, false); // false means don't create if it doesn't already exist
	if(!v) return false;
	value = SvIV(v);
	return true;
	//</CPerlWrap>
}

bool CPerl::SetFloat(const CScript& script, LPCSTR szVariable, const double value)
{
	COMMON_SET(script, szVariable);
	//<CPerlWrap>
	SV *v = get_sv(szVariable, true|GV_ADDMULTI);
	if (!v) return false;
	sv_setnv(v, value);
	return true;
	//</CPerlWrap>
}

bool CPerl::GetFloat(const CScript& script, LPCSTR szVariable, double &value)
{
	COMMON_GET(script, szVariable);
	//<CPerlWrap>
	SV *v = get_sv(szVariable, false);
	if (!v) return false;
	value = SvNV(v);
	return true;
	//</CPerlWrap>
}

bool CPerl::SetString(const CScript& script, LPCSTR szVariable, LPCSTR value)
{
	COMMON_SET(script, szVariable);
	//<CPerlWrap>
	SV *v = get_sv(szVariable, true|GV_ADDMULTI);
	if (!v) return false;
	sv_setpv(v, value);
	return true;
	//</CPerlWrap>
}

bool CPerl::GetString(const CScript& script, LPCSTR szVariable, CStringA &value)
{
	COMMON_GET(script, szVariable);
	//<CPerlWrap>
	SV *v = get_sv(szVariable, false);
	if (!v) return false;
	value = (LPCSTR)SvPV_nolen(v);
	return true;
	//</CPerlWrap>
}

#ifndef _UNICODE

bool CPerl::SetArray(const CScript& script, LPCSTR szVariable, const CStringArray &array,
					 bool bAppend)
{
	COMMON_SET(script, szVariable);

	AV *v = get_av(szVariable, true|GV_ADDMULTI);
	if (!v)
		return false;

	if (!bAppend)
		av_clear(v);

	int len = av_len(v);
	int nSize = (int)array.GetSize();

	// Allocate memory
	av_fill(v, len + nSize);

	for (int i=0; i<nSize; i++)
	{
		len++;
		SV *val = newSVpv((LPCSTR)array.GetAt(i),0);
		if (val)
			av_store(v, len, val);
	}

	return true;
}

bool CPerl::GetArray(const CScript& script, LPCSTR szVariable, CStringArray &array,
					 bool bAppend)
{
	COMMON_GET(script, szVariable);

	AV *v = get_av(szVariable, false);

	if (!v)
		return false;

	if (!bAppend)
		array.SetSize(0);

	int len = av_len(v) + 1; // number of elements in array

	/*
	Note from VC++ doc :
	Before using an array, use SetSize to establish its size and allocate memory for it. If you do not use SetSize, adding elements to your array causes it to be frequently reallocated and copied. Frequent reallocation and copying are inefficient and can fragment memory.
	*/
	int nSize = (int)array.GetSize();
	array.SetSize(nSize + len);

	for (int i=0; i<len; i++)
	{
		SV **val = av_fetch(v, i, 0); // 0 means to not change the value
		if (!val)
			return false;

		array.SetAt(nSize + i, SvPV_nolen(*val));
	}

	return true;
}

#else

bool CPerl::SetArray(const CScript& script, LPCSTR szVariable, const CStringArrayA &array,
					 bool bAppend)
{
	COMMON_SET(script, szVariable);

	AV *v = get_av(szVariable, true|GV_ADDMULTI);
	if (!v)
		return false;

	if (!bAppend)
		av_clear(v);

	int len = av_len(v);
	int nSize = (int)array.GetSize();

	// Allocate memory
	av_fill(v, len + nSize);

	for (int i=0; i<nSize; i++)
	{
		len++;
		SV *val = newSVpv((LPCSTR)array.GetAt(i),0);
		if (val)
			av_store(v, len, val);
	}

	return true;
}

bool CPerl::GetArray(const CScript& script, LPCSTR szVariable, CStringArrayA &array,
					 bool bAppend)
{
	COMMON_GET(script, szVariable);

	AV *v = get_av(szVariable, false);

	if (!v)
		return false;

	if (!bAppend)
		array.SetSize(0);

	int len = av_len(v) + 1; // number of elements in array

	int nSize = (int)array.GetSize();
	array.SetSize(nSize + len);

	for (int i=0; i<len; i++)
	{
		SV **val = av_fetch(v, i, 0); // 0 means to not change the value
		if (!val)
			return false;

		array.SetAt(nSize + i, SvPV_nolen(*val));
	}

	return true;
}

#endif


///////////////////////////////////////////////////////////////
// CPerlConfigFile

bool CPerlConfigFile::Flush(LPCSTR szFile, bool bReset)
{
	bool bRet = true;
	if (szFile)
		bRet = PXWriteCreateFile(szFile, m_strOutput);
	if (bReset)
		m_strOutput.Empty();
	return bRet;
}

void CPerlConfigFile::WriteInt(LPCSTR szVariable, int value, LPCSTR szComment, int *pnDefault)
{
	CStringA strTemp;
	char buf[64];
	_itoa(value, buf, 10);
	if (pnDefault)
	{
		char buf2[64];
		_itoa(*pnDefault, buf2, 10);
		strTemp.Format(g_szOutputFormatWithDefault, szVariable, "Integer", buf2, szComment, "$" + CStringA(szVariable), buf);
	}
	else
		strTemp.Format(g_szOutputFormat, szVariable, "Integer", szComment, "$" + CStringA(szVariable), buf);
	m_strOutput += strTemp;
}

void CPerlConfigFile::WriteBool(LPCSTR szVariable, bool value, LPCSTR szComment, bool *pbDefault)
{
	CStringA strTemp;
	char buf[64];
	_itoa(value, buf, 10);
	if (pbDefault)
	{
		char buf2[64];
		_itoa(*pbDefault, buf2, 10);
		strTemp.Format(g_szOutputFormatWithDefault, szVariable, "Boolean", buf2, szComment, "$" + CStringA(szVariable), buf);
	}
	else
		strTemp.Format(g_szOutputFormat, szVariable, "Boolean", szComment, "$" + CStringA(szVariable), buf);
	m_strOutput += strTemp;
}

void CPerlConfigFile::WriteFloat(LPCSTR szVariable, double value, LPCSTR szComment, double *pdDefault)
{
	CStringA strTemp;
	char buf[64];
	_gcvt(value, 31, buf);
	if (pdDefault)
	{
		char buf2[64];
		_gcvt(*pdDefault, 31, buf2);
		strTemp.Format(g_szOutputFormatWithDefault, szVariable, "Float", buf2, szComment, "$" + CStringA(szVariable), buf);
	}
	else
		strTemp.Format(g_szOutputFormat, szVariable, "Float", szComment, "$" + CStringA(szVariable), buf);
	m_strOutput += strTemp;
}

void CPerlConfigFile::WriteString(LPCSTR szVariable, LPCSTR value, LPCSTR szComment, char cDelim, CStringA *pstrDefault)
{
	CStringA strTemp, strTemp2;
	strTemp2.Format("q%c%s%c", cDelim, value, cDelim);
	strTemp2.Replace("\\", "\\\\");
	if (pstrDefault)
		strTemp.Format(g_szOutputFormatWithDefault, szVariable, "String", LPCSTR(*pstrDefault), szComment, "$" + CStringA(szVariable), LPCSTR(strTemp2));
	else
		strTemp.Format(g_szOutputFormat, szVariable, "String", szComment, "$" + CStringA(szVariable), LPCSTR(strTemp2));
	m_strOutput += strTemp;
}

void CPerlConfigFile::WriteStringArray(LPCSTR szVariable, CStringArray &array, LPCSTR szComment, char cDelim)
{
	CStringA strTemp("(\n"), strTemp2;
	int nSize = (int)array.GetSize();
	for (int i=0; i<nSize; i++)
	{
		strTemp2.Format("\tq%c%s%c,\n", cDelim, array[i], cDelim);
		strTemp2.Replace("\\", "\\\\");
		strTemp += strTemp2;
	}
	strTemp += ")";

	strTemp2.Format(g_szOutputFormat, szVariable, "Array of Strings", szComment, "@" + CStringA(szVariable), LPCSTR(strTemp));
	m_strOutput += strTemp2;
}

}