The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
//
// (C) Copyright 2011-2012 Sergey A. Babkin.
// This file is a part of Triceps.
// See the file COPYRIGHT for the copyright notice and license information
//
// The encapsulation of Perl compare function for the sorted index.

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "TricepsPerl.h"
#include "PerlCallback.h"
#include "PerlSortCondition.h"

namespace TRICEPS_NS
{
namespace TricepsPerl 
{

PerlSortCondition::PerlSortCondition(const char *sortName, Onceref<PerlCallback> cbInit, Onceref<PerlCallback> cbCompare) :
	cbInitialize_(cbInit), 
	cbCompare_(cbCompare),
	initialized_(false),
	svRowType_(NULL),
	tabType_(NULL),
	name_(sortName)
{ }

// always makes an uninitialized copy!
PerlSortCondition::PerlSortCondition(const PerlSortCondition &other) :
	cbInitialize_(other.cbInitialize_), 
	cbCompare_(other.cbCompare_),
	initialized_(false),
	svRowType_(NULL),
	tabType_(NULL),
	name_(other.name_) // name stays the same!
{ }

PerlSortCondition::~PerlSortCondition()
{
	if (svRowType_ != NULL)
		SvREFCNT_dec(svRowType_);
}


bool PerlSortCondition::equals(const SortedIndexCondition *sc) const
{
	const PerlSortCondition *psc = dynamic_cast<const PerlSortCondition *>(sc);

	return name_ == psc->name_
		&& callbackEquals(cbInitialize_, psc->cbInitialize_)
		&& callbackEquals(cbCompare_, psc->cbCompare_);
}

bool PerlSortCondition::match(const SortedIndexCondition *sc) const
{
	const PerlSortCondition *psc = dynamic_cast<const PerlSortCondition *>(sc);

	return callbackEquals(cbInitialize_, psc->cbInitialize_)
		&& callbackEquals(cbCompare_, psc->cbCompare_);
}

void PerlSortCondition::printTo(string &res, const string &indent, const string &subindent) const
{
	res.append("PerlSortedIndex(");
	res.append(name_);
	res.append(")");
}

SortedIndexCondition *PerlSortCondition::copy() const
{
	return new PerlSortCondition(*this);
}

bool PerlSortCondition::operator() (const RowHandle *r1, const RowHandle *r2) const
{
	dSP;

	if (cbCompare_.isNull())
		return false; // should never happen but just in case

	// the rows are passed to Perl as Rows, not RowHandles, because
	// wrapping the RowHandle requires a table pointer which is not available
	WrapRow *wr1 = new WrapRow(rt_, const_cast<Row *>(r1->getRow()));
	SV *svr1 = newSV(0);
	sv_setref_pv(svr1, "Triceps::Row", (void *)wr1);

	WrapRow *wr2 = new WrapRow(rt_, const_cast<Row *>(r2->getRow()));
	SV *svr2 = newSV(0);
	sv_setref_pv(svr2, "Triceps::Row", (void *)wr2);

	PerlCallbackStartCall(cbCompare_);
	XPUSHs(svr1);
	XPUSHs(svr2);

	SV *svrcode = NULL;
	PerlCallbackDoCallScalar(cbCompare_, svrcode);

	SvREFCNT_dec(svr1);
	SvREFCNT_dec(svr2);

	bool result = false; // the safe default, collapses all keys into one

	if (SvTRUE(ERRSV)) {
		// Would exit(1) be better?
		warn("Error in PerlSortedIndex(%s) comparator: %s", 
			name_.c_str(), SvPV_nolen(ERRSV));
	} else if (svrcode == NULL) {
		// Would exit(1) be better?
		warn("Error in PerlSortedIndex(%s) comparator: comparator returned no value", 
			name_.c_str());
	} else if (!SvIOK(svrcode)) {
		// Would exit(1) be better?
		warn("Error in PerlSortedIndex(%s) comparator: comparator returned a non-integer value '%s'", 
			name_.c_str(), SvPV_nolen(svrcode));
	} else {
		result = (SvIV(svrcode) < 0); // the Less
	}

	if (svrcode != NULL)
		SvREFCNT_dec(svrcode);
	return result;
}

void PerlSortCondition::initialize(Erref &errors, TableType *tabtype, SortedIndexType *indtype)
{
	if (initialized_)
		return; // skip the second initialization

	dSP;

	tabType_ = tabtype;

	// save the wrapped row type in any case
	if (svRowType_ != NULL)
		SvREFCNT_dec(svRowType_);
	WrapRowType *wrowt = new WrapRowType(const_cast<RowType *>(rt_.get()));
	svRowType_ = newSV(0);
	sv_setref_pv(svRowType_, "Triceps::RowType", (void *)wrowt);

	if (!cbInitialize_.isNull()) {
		WrapTableType *wtabt = new WrapTableType(tabtype);
		SV *svtabt = newSV(0);
		sv_setref_pv(svtabt, "Triceps::TableType", (void *)wtabt);

		WrapIndexType *widxt = new WrapIndexType(indtype);
		SV *svidxt = newSV(0);
		sv_setref_pv(svidxt, "Triceps::IndexType", (void *)widxt);

		PerlCallbackStartCall(cbInitialize_);
		XPUSHs(svtabt);
		XPUSHs(svidxt);
		XPUSHs(svRowType_);

		SV *sverrmsg = NULL;
		PerlCallbackDoCallScalar(cbInitialize_, sverrmsg);

		// this calls the DELETE methods on wrappers
		SvREFCNT_dec(svtabt);
		SvREFCNT_dec(svidxt);

		if (sverrmsg != NULL && SvTRUE(sverrmsg)) {
			errors->appendMultiline(true, SvPV_nolen(sverrmsg));
			return;
		}

		if (SvTRUE(ERRSV)) {
			errors->appendMultiline(true, SvPV_nolen(ERRSV));
			return;
		}
	}

	// the comparator must be set by now, or it's an error
	if (cbCompare_.isNull()) {
		errors->appendMsg(true, "the mandatory comparator Perl function is not set by PerlSortedIndex(" + name_ + ")");
	}

	initialized_ = true;
}

bool PerlSortCondition::setComparator(Onceref<PerlCallback> cbComparator)
{
	if (initialized_)
		return false;
	cbCompare_ = cbComparator;
	return true;
}


}; // Triceps::TricepsPerl
}; // Triceps