Click here to Skip to main content
Click here to Skip to main content
 
Add your own
alternative version

PXPerlWrap (PXPerl, reloaded)

, 3 Nov 2004
A comprehensive Perl embedding solution.
pxperldemo.zip
PXPerlDemo.dsp
PXPerlDemo.dsw
PXPerlDemo.suo
PERL_CORE
arpa
perl58.lib
PerlEz.lib
sys
Release
lib
auto
PerlIO
encoding
encoding.dll
scalar
scalar.dll
via
via.dll
Carp.pm
Exporter.pm
PerlIO
encoding.pm
scalar.pm
via
QuotedPrint.pm
via.pm
PerlIO.pm
strict.pm
Symbol.pm
THESE ARE REQUIRED LIBs
warnings.pm
XSLoader.pm
perl58.dll
PXPerlDemo.exe
res
perl.ico
perl2.ico
perl3.ico
perlsistent.pl
PXPerlDemo.ico
PXPerlDemo.manifest
PXPerlDemo.clw
PXPerlDemo.mak
pxperl_demo.zip
PXPerlDemo.mak
PXPerlDemo.dsp
PXPerlDemo.dsw
PXPerlDemo.suo
perl58.lib
PerlEz.lib
encoding.dll
scalar.dll
via.dll
Carp.pm
Exporter.pm
encoding.pm
scalar.pm
QuotedPrint.pm
via.pm
PerlIO.pm
strict.pm
Symbol.pm
THESE ARE REQUIRED LIBs
warnings.pm
XSLoader.pm
perl58.dll
PXPerlDemo.exe
perl.ico
perl2.ico
perl3.ico
perlsistent.pl
PXPerlDemo.ico
PXPerlDemo.manifest
PXPerlDemo.aps
PXPerlDemo.clw
PXPerlDemo.dep
PXPerlDemo.opt
PXPerlDemo.plg
// 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")

// I don't know if the following is really necessary
#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\
													  ";


CString 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

CString 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;
}

void PXPathAppend(CString &strPath, LPCSTR szAppend)
{
	PathAppendA(strPath.GetBuffer(MAX_PATH), szAppend);
	strPath.ReleaseBuffer();
}

void PXPerlErrorMsgBox(LPCSTR szText)
{
	::MessageBoxA(AfxGetMainWnd()->GetSafeHwnd(), szText, "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);
}

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, CString &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 CString &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, CString &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:
		{
			CString 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;
	CString strPackageName((LPCSTR)sPackageName);
	delete [] sPackageName;

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

	CString 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)
{
	CString 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;
	}

	CString 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(CString &strContents)
{
	if (!PXPerlCallRetString(m_pMyPerl, "get_stderr", strContents))
		return false;
	return (strContents.IsEmpty()==0);
}

bool CPerl::GetSTDOUT(CString &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");
}

void CPerl::SetAutoEmpty(bool bAuto)
{
	m_bAutoEmpty = bAuto;
}

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, CString &value)
{
	COMMON_GET(script, szVariable);
	//<CPerlWrap>
	SV *v = get_sv(szVariable, false);
	if (!v) return false;
	value = (LPCSTR)SvPV_nolen(v);
	return true;
	//</CPerlWrap>
}

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

	//<CPerlWrap, highly modified>
	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);
	}

	//</CPerlWrap>

	return true;
}

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

	//<CPerlWrap, highly modified>
	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));
	}
	//</CPerlWrap>

	return true;
}

bool CPerl::SetHash(const CScript& script, LPCSTR szVariable,
					const CMapStringToString &hash,
					 bool bAppend)
{
	COMMON_SET(script, szVariable);

	//<CPerlWrap>
	HV *v = get_hv(szVariable, true|GV_ADDMULTI);

	if(!v)
		return false;

	if (!bAppend)
		hv_clear(v);

	CString strKey;
	CString strVal;
	POSITION pos = hash.GetStartPosition();
	while (pos)
	{
		hash.GetNextAssoc(pos, strKey, strVal);

		SV *svVal = newSVpv(LPCSTR(strVal), 0);
		if(!svVal)
			return false;

		hv_store(v, LPCSTR(strKey), strKey.GetLength(), svVal, 0);
	}
	//</CPerlWrap>

	return true;
}

bool CPerl::GetHash(const CScript& script, LPCSTR szVariable,
					CMapStringToString &hash, bool bAppend)
{
	COMMON_GET(script, szVariable);

	//<CPerlWrap, modified>
	HV *v = get_hv(szVariable, false);

	if(!v)
		return false;

	if (!bAppend)
		hash.RemoveAll();

	hv_iterinit(v);	// get beginning iterator
	HE *hashEntry;	// pointer to current hashentry

	I32 nKeyLen;
	//char *buffer = new char[nKeyLen];

	while (hashEntry = hv_iternext(v))
	{
		// Get the key
		char *sKeyName = hv_iterkey(hashEntry, &nKeyLen);
		if (!sKeyName)
			return false;
		SV *svVal = hv_iterval(v, hashEntry);
		hash.SetAt((LPCSTR)sKeyName, svVal ? (LPCSTR)SvPV_nolen(svVal) : "");
	}
	//</CPerlWrap>

	return true;
}

///////////////////////////////////////////////////////////////
// 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)
{
	CString 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, "$" + CString(szVariable), buf);
	}
	else
		strTemp.Format(g_szOutputFormat, szVariable, "Integer", szComment, "$" + CString(szVariable), buf);
	m_strOutput += strTemp;
}

void CPerlConfigFile::WriteBool(LPCSTR szVariable, bool value, LPCSTR szComment, bool *pbDefault)
{
	CString 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, "$" + CString(szVariable), buf);
	}
	else
		strTemp.Format(g_szOutputFormat, szVariable, "Boolean", szComment, "$" + CString(szVariable), buf);
	m_strOutput += strTemp;
}

void CPerlConfigFile::WriteFloat(LPCSTR szVariable, double value, LPCSTR szComment, double *pdDefault)
{
	CString 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, "$" + CString(szVariable), buf);
	}
	else
		strTemp.Format(g_szOutputFormat, szVariable, "Float", szComment, "$" + CString(szVariable), buf);
	m_strOutput += strTemp;
}

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

void CPerlConfigFile::WriteStringArray(LPCSTR szVariable, CStringArray &array, LPCSTR szComment, char cDelim)
{
	CString 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, "@" + CString(szVariable), LPCSTR(strTemp));
	m_strOutput += strTemp2;
}

}

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here

Share

About the Author

PixiGreg
Software Developer
France France
Bouh

| Advertise | Privacy | Terms of Use | Mobile
Web03 | 2.8.141220.1 | Last Updated 3 Nov 2004
Article Copyright 2003 by PixiGreg
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid