/*
* Set up for a new collation locale.
*/
void
Perl_new_collate(pTHX_ char *newcoll)
{
#ifdef USE_LOCALE_COLLATE
if (! newcoll) {
if (PL_collation_name) {
++PL_collation_ix;
Safefree(PL_collation_name);
PL_collation_name = NULL;
}
PL_collation_standard = TRUE;
PL_collxfrm_base = 0;
PL_collxfrm_mult = 2;
return;
}
if (! PL_collation_name || strNE(PL_collation_name, newcoll)) {
++PL_collation_ix;
Safefree(PL_collation_name);
PL_collation_name = stdize_locale(savepv(newcoll));
PL_collation_standard = ((*newcoll == 'C' && newcoll[1] == '\0')
|| strEQ(newcoll, "POSIX"));
{
/* 2: at most so many chars ('a', 'b'). */
/* 50: surely no system expands a char more. */
#define XFRMBUFSIZE (2 * 50)
char xbuf[XFRMBUFSIZE];
const Size_t fa = strxfrm(xbuf, "a", XFRMBUFSIZE);
const Size_t fb = strxfrm(xbuf, "ab", XFRMBUFSIZE);
const SSize_t mult = fb - fa;
if (mult < 1)
Perl_croak(aTHX_ "strxfrm() gets absurd");
PL_collxfrm_base = (fa > (Size_t)mult) ? (fa - mult) : 0;
PL_collxfrm_mult = mult;
}
}
#endif /* USE_LOCALE_COLLATE */
}
int sigar_file_system_list_get(sigar_t *sigar,
sigar_file_system_list_t *fslist)
{
struct mntent *ent;
FILE *fp;
sigar_file_system_t *fsp;
if (!(fp = setmntent(MNT_CHECKLIST, "r"))) {
return errno;
}
sigar_file_system_list_create(fslist);
while ((ent = getmntent(fp))) {
if ((*(ent->mnt_type) == 's') &&
strEQ(ent->mnt_type, "swap"))
{
/*
* in this case, devname == "...", for
* which statfs chokes on. so skip it.
* also notice hpux df command has no swap info.
*/
continue;
}
SIGAR_FILE_SYSTEM_LIST_GROW(fslist);
fsp = &fslist->data[fslist->number++];
SIGAR_SSTRCPY(fsp->dir_name, ent->mnt_dir);
SIGAR_SSTRCPY(fsp->dev_name, ent->mnt_fsname);
SIGAR_SSTRCPY(fsp->sys_type_name, ent->mnt_type);
SIGAR_SSTRCPY(fsp->options, ent->mnt_opts);
sigar_fs_type_init(fsp);
}
endmntent(fp);
return SIGAR_OK;
}
int
move_file(const char *from, const char *to)
{
int fromfd;
ssize_t i;
/* to stdout? */
if (strEQ(to, "-")) {
#ifdef DEBUGGING
if (debug & 4)
say("Moving %s to stdout.\n", from);
#endif
fromfd = open(from, O_RDONLY);
if (fromfd < 0)
pfatal("internal error, can't reopen %s", from);
while ((i = read(fromfd, buf, buf_size)) > 0)
if (write(STDOUT_FILENO, buf, i) != i)
pfatal("write failed");
close(fromfd);
return 0;
}
if (backup_file(to) < 0) {
say("Can't backup %s, output is in %s: %s\n", to, from,
strerror(errno));
return -1;
}
#ifdef DEBUGGING
if (debug & 4)
say("Moving %s to %s.\n", from, to);
#endif
if (rename(from, to) < 0) {
if (errno != EXDEV || copy_file(from, to) < 0) {
say("Can't create %s, output is in %s: %s\n",
to, from, strerror(errno));
return -1;
}
}
return 0;
}
/*
* Open the patch file at the beginning of time.
*/
void
open_patch_file(const char *filename)
{
struct stat filestat;
if (filename == NULL || *filename == '\0' || strEQ(filename, "-")) {
pfp = fopen(TMPPATNAME, "w");
if (pfp == NULL)
pfatal("can't create %s", TMPPATNAME);
while (fgets(buf, sizeof buf, stdin) != NULL)
fputs(buf, pfp);
fclose(pfp);
filename = TMPPATNAME;
}
pfp = fopen(filename, "r");
if (pfp == NULL)
pfatal("patch file %s not found", filename);
fstat(fileno(pfp), &filestat);
p_filesize = filestat.st_size;
next_intuit_at(0L, 1L); /* start at the beginning */
set_hunkmax();
}
omxExpectation *
omxNewInternalExpectation(const char *expType, omxState* os)
{
omxExpectation* expect = 0;
/* Switch based on Expectation type. */
for (size_t ex=0; ex < OMX_STATIC_ARRAY_SIZE(omxExpectationSymbolTable); ex++) {
const omxExpectationTableEntry *entry = omxExpectationSymbolTable + ex;
if(strEQ(expType, entry->name)) {
expect = entry->initFun();
expect->expType = entry->name;
break;
}
}
if (!expect) Rf_error("expectation '%s' not recognized", expType);
expect->currentState = os;
expect->canDuplicate = true;
expect->dynamicDataSource = false;
return expect;
}
/*
* Set up for a new numeric locale.
*/
void
Perl_new_numeric(pTHX_ char *newnum)
{
#ifdef USE_LOCALE_NUMERIC
if (! newnum) {
Safefree(PL_numeric_name);
PL_numeric_name = NULL;
PL_numeric_standard = TRUE;
PL_numeric_local = TRUE;
return;
}
if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) {
Safefree(PL_numeric_name);
PL_numeric_name = stdize_locale(savepv(newnum));
PL_numeric_standard = ((*newnum == 'C' && newnum[1] == '\0')
|| strEQ(newnum, "POSIX"));
PL_numeric_local = TRUE;
set_numeric_radix();
}
#endif /* USE_LOCALE_NUMERIC */
}
void omxComputeNumericDeriv::initFromFrontend(omxState *state, SEXP rObj)
{
super::initFromFrontend(state, rObj);
/*if (state->conListX.size()) {
mxThrow("%s: cannot proceed with constraints (%d constraints found)",
name, int(state->conListX.size()));
}*/
fitMat = omxNewMatrixFromSlot(rObj, state, "fitfunction");
SEXP slotValue;
Rf_protect(slotValue = R_do_slot(rObj, Rf_install("iterations")));
numIter = INTEGER(slotValue)[0];
if (numIter < 2) mxThrow("stepSize must be 2 or greater");
Rf_protect(slotValue = R_do_slot(rObj, Rf_install("parallel")));
parallel = Rf_asLogical(slotValue);
Rf_protect(slotValue = R_do_slot(rObj, Rf_install("checkGradient")));
checkGradient = Rf_asLogical(slotValue);
Rf_protect(slotValue = R_do_slot(rObj, Rf_install("verbose")));
verbose = Rf_asInteger(slotValue);
{
ProtectedSEXP Rhessian(R_do_slot(rObj, Rf_install("hessian")));
wantHessian = Rf_asLogical(Rhessian);
}
Rf_protect(slotValue = R_do_slot(rObj, Rf_install("stepSize")));
stepSize = GRADIENT_FUDGE_FACTOR(3.0) * REAL(slotValue)[0];
if (stepSize <= 0) mxThrow("stepSize must be positive");
knownHessian = NULL;
{
ScopedProtect(slotValue, R_do_slot(rObj, Rf_install("knownHessian")));
if (!Rf_isNull(slotValue)) {
knownHessian = REAL(slotValue);
SEXP dimnames;
ScopedProtect pdn(dimnames, Rf_getAttrib(slotValue, R_DimNamesSymbol));
{
SEXP names;
ScopedProtect p1(names, VECTOR_ELT(dimnames, 0));
{
int nlen = Rf_length(names);
khMap.assign(nlen, -1);
for (int nx=0; nx < nlen; ++nx) {
const char *vname = CHAR(STRING_ELT(names, nx));
for (int vx=0; vx < int(varGroup->vars.size()); ++vx) {
if (strEQ(vname, varGroup->vars[vx]->name)) {
khMap[nx] = vx;
if (verbose >= 1) mxLog("%s: knownHessian[%d] '%s' mapped to %d",
name, nx, vname, vx);
break;
}
}
}
}
}
}
}
numParams = 0;
totalProbeCount = 0;
numParams = 0;
recordDetail = true;
detail = 0;
}
void ifaGroup::import(SEXP Rlist)
{
SEXP argNames;
Rf_protect(argNames = Rf_getAttrib(Rlist, R_NamesSymbol));
if (Rf_length(Rlist) != Rf_length(argNames)) {
mxThrow("All list elements must be named");
}
std::vector<const char *> dataColNames;
paramRows = -1;
int pmatCols=-1;
int mips = 1;
int dataRows = 0;
SEXP Rmean=0, Rcov=0;
for (int ax=0; ax < Rf_length(Rlist); ++ax) {
const char *key = R_CHAR(STRING_ELT(argNames, ax));
SEXP slotValue = VECTOR_ELT(Rlist, ax);
if (strEQ(key, "spec")) {
importSpec(slotValue);
} else if (strEQ(key, "param")) {
if (!Rf_isReal(slotValue)) mxThrow("'param' must be a numeric matrix of item parameters");
param = REAL(slotValue);
getMatrixDims(slotValue, ¶mRows, &pmatCols);
SEXP dimnames;
Rf_protect(dimnames = Rf_getAttrib(slotValue, R_DimNamesSymbol));
if (!Rf_isNull(dimnames) && Rf_length(dimnames) == 2) {
SEXP names;
Rf_protect(names = VECTOR_ELT(dimnames, 0));
int nlen = Rf_length(names);
factorNames.resize(nlen);
for (int nx=0; nx < nlen; ++nx) {
factorNames[nx] = CHAR(STRING_ELT(names, nx));
}
Rf_protect(names = VECTOR_ELT(dimnames, 1));
nlen = Rf_length(names);
itemNames.resize(nlen);
for (int nx=0; nx < nlen; ++nx) {
itemNames[nx] = CHAR(STRING_ELT(names, nx));
}
}
} else if (strEQ(key, "mean")) {
Rmean = slotValue;
if (!Rf_isReal(slotValue)) mxThrow("'mean' must be a numeric vector or matrix");
mean = REAL(slotValue);
} else if (strEQ(key, "cov")) {
Rcov = slotValue;
if (!Rf_isReal(slotValue)) mxThrow("'cov' must be a numeric matrix");
cov = REAL(slotValue);
} else if (strEQ(key, "data")) {
Rdata = slotValue;
dataRows = Rf_length(VECTOR_ELT(Rdata, 0));
SEXP names;
Rf_protect(names = Rf_getAttrib(Rdata, R_NamesSymbol));
int nlen = Rf_length(names);
dataColNames.reserve(nlen);
for (int nx=0; nx < nlen; ++nx) {
dataColNames.push_back(CHAR(STRING_ELT(names, nx)));
}
Rf_protect(dataRowNames = Rf_getAttrib(Rdata, R_RowNamesSymbol));
} else if (strEQ(key, "weightColumn")) {
if (Rf_length(slotValue) != 1) {
mxThrow("You can only have one %s", key);
}
weightColumnName = CHAR(STRING_ELT(slotValue, 0));
} else if (strEQ(key, "freqColumn")) {
if (Rf_length(slotValue) != 1) {
mxThrow("You can only have one %s", key);
}
freqColumnName = CHAR(STRING_ELT(slotValue, 0));
} else if (strEQ(key, "qwidth")) {
qwidth = Rf_asReal(slotValue);
} else if (strEQ(key, "qpoints")) {
qpoints = Rf_asInteger(slotValue);
} else if (strEQ(key, "minItemsPerScore")) {
mips = Rf_asInteger(slotValue);
} else {
// ignore
}
}
learnMaxAbilities();
if (itemDims < (int) factorNames.size())
factorNames.resize(itemDims);
if (int(factorNames.size()) < itemDims) {
factorNames.reserve(itemDims);
const int SMALLBUF = 24;
char buf[SMALLBUF];
while (int(factorNames.size()) < itemDims) {
snprintf(buf, SMALLBUF, "s%d", int(factorNames.size()) + 1);
factorNames.push_back(CHAR(Rf_mkChar(buf)));
}
}
if (Rmean) {
if (Rf_isMatrix(Rmean)) {
int nrow, ncol;
getMatrixDims(Rmean, &nrow, &ncol);
if (!(nrow * ncol == itemDims && (nrow==1 || ncol==1))) {
mxThrow("mean must be a column or row matrix of length %d", itemDims);
}
} else {
if (Rf_length(Rmean) != itemDims) {
mxThrow("mean must be a vector of length %d", itemDims);
}
}
verifyFactorNames(Rmean, "mean");
}
if (Rcov) {
if (Rf_isMatrix(Rcov)) {
int nrow, ncol;
getMatrixDims(Rcov, &nrow, &ncol);
if (nrow != itemDims || ncol != itemDims) {
mxThrow("cov must be %dx%d matrix", itemDims, itemDims);
}
} else {
if (Rf_length(Rcov) != 1) {
mxThrow("cov must be %dx%d matrix", itemDims, itemDims);
}
}
verifyFactorNames(Rcov, "cov");
}
setLatentDistribution(mean, cov);
setMinItemsPerScore(mips);
if (numItems() != pmatCols) {
mxThrow("item matrix implies %d items but spec is length %d",
pmatCols, numItems());
}
if (Rdata) {
if (itemNames.size() == 0) mxThrow("Item matrix must have colnames");
for (int ix=0; ix < numItems(); ++ix) {
bool found=false;
for (int dc=0; dc < int(dataColNames.size()); ++dc) {
if (strEQ(itemNames[ix], dataColNames[dc])) {
SEXP col = VECTOR_ELT(Rdata, dc);
if (!Rf_isFactor(col)) {
if (TYPEOF(col) == INTSXP) {
mxThrow("Column '%s' is an integer but "
"not an ordered factor",
dataColNames[dc]);
} else {
mxThrow("Column '%s' is of type %s; expecting an "
"ordered factor (integer)",
dataColNames[dc], Rf_type2char(TYPEOF(col)));
}
}
dataColumns.push_back(INTEGER(col));
found=true;
break;
}
}
if (!found) {
mxThrow("Cannot find item '%s' in data", itemNames[ix]);
}
}
if (weightColumnName) {
for (int dc=0; dc < int(dataColNames.size()); ++dc) {
if (strEQ(weightColumnName, dataColNames[dc])) {
SEXP col = VECTOR_ELT(Rdata, dc);
if (TYPEOF(col) != REALSXP) {
mxThrow("Column '%s' is of type %s; expecting type numeric (double)",
dataColNames[dc], Rf_type2char(TYPEOF(col)));
}
rowWeight = REAL(col);
break;
}
}
if (!rowWeight) {
mxThrow("Cannot find weight column '%s'", weightColumnName);
}
}
if (freqColumnName) {
for (int dc=0; dc < int(dataColNames.size()); ++dc) {
if (strEQ(freqColumnName, dataColNames[dc])) {
SEXP col = VECTOR_ELT(Rdata, dc);
if (TYPEOF(col) != INTSXP) {
mxThrow("Column '%s' is of type %s; expecting type integer",
dataColNames[dc], Rf_type2char(TYPEOF(col)));
}
rowFreq = INTEGER(col);
break;
}
}
if (!rowFreq) {
mxThrow("Cannot find frequency column '%s'", freqColumnName);
}
}
rowMap.reserve(dataRows);
for (int rx=0; rx < dataRows; ++rx) rowMap.push_back(rx);
}
Eigen::Map< Eigen::ArrayXXd > Eparam(param, paramRows, numItems());
Eigen::Map< Eigen::VectorXd > meanVec(mean, itemDims);
Eigen::Map< Eigen::MatrixXd > covMat(cov, itemDims, itemDims);
quad.setStructure(qwidth, qpoints, Eparam, meanVec, covMat);
if (paramRows < impliedParamRows) {
mxThrow("At least %d rows are required in the item parameter matrix, only %d found",
impliedParamRows, paramRows);
}
quad.refresh(meanVec, covMat);
}
int sigar_os_open(sigar_t **sig)
{
kstat_ctl_t *kc;
kstat_t *ksp;
sigar_t *sigar;
int i, status;
struct utsname name;
char *ptr;
if ((kc = kstat_open()) == NULL) {
*sig = NULL;
return errno;
}
/*
* Use calloc instead of malloc to set everything to 0
* to avoid having to set each individual member to 0/NULL
* later.
*/
if ((*sig = sigar = calloc(1, sizeof(*sigar))) == NULL) {
return ENOMEM;
}
uname(&name);
if ((ptr = strchr(name.release, '.'))) {
sigar->solaris_version = atoi(ptr + 1);
}
else {
sigar->solaris_version = 6;
}
if ((ptr = getenv("SIGAR_USE_UCB_PS"))) {
sigar->use_ucb_ps = strEQ(ptr, "true");
}
if (sigar->use_ucb_ps) {
if (access(SIGAR_USR_UCB_PS, X_OK) == -1) {
sigar->use_ucb_ps = 0;
}
else {
sigar->use_ucb_ps = 1;
}
}
sigar->pagesize = 0;
i = sysconf(_SC_PAGESIZE);
while ((i >>= 1) > 0) {
sigar->pagesize++;
}
sigar->ticks = sysconf(_SC_CLK_TCK);
sigar->kc = kc;
sigar->koffsets.system[0] = -1;
sigar->koffsets.mempages[0] = -1;
sigar->koffsets.syspages[0] = -1;
if ((status = sigar_get_kstats(sigar)) != SIGAR_OK) {
fprintf(stderr, "status=%d\n", status);
}
if ((ksp = sigar->ks.system) &&
(kstat_read(kc, ksp, NULL) >= 0))
{
sigar_koffsets_init_system(sigar, ksp);
sigar->boot_time = kSYSTEM(KSTAT_SYSTEM_BOOT_TIME);
}
sigar->last_pid = -1;
sigar->mib2.sd = -1;
return SIGAR_OK;
}
DWORD c_constant(char *name)
{
switch (*name) {
case 'A':
break;
case 'B':
if (strEQ(name, "BACKGROUND_BLUE"))
#ifdef BACKGROUND_BLUE
return BACKGROUND_BLUE;
#else
goto not_there;
#endif
if (strEQ(name, "BACKGROUND_GREEN"))
#ifdef BACKGROUND_GREEN
return BACKGROUND_GREEN;
#else
goto not_there;
#endif
if (strEQ(name, "BACKGROUND_INTENSITY"))
#ifdef BACKGROUND_INTENSITY
return BACKGROUND_INTENSITY;
#else
goto not_there;
#endif
if (strEQ(name, "BACKGROUND_RED"))
#ifdef BACKGROUND_RED
return BACKGROUND_RED;
#else
goto not_there;
#endif
break;
case 'C':
if (strEQ(name, "CAPSLOCK_ON"))
#ifdef CAPSLOCK_ON
return CAPSLOCK_ON;
#else
goto not_there;
#endif
if (strEQ(name, "CONSOLE_TEXTMODE_BUFFER"))
#ifdef CONSOLE_TEXTMODE_BUFFER
return CONSOLE_TEXTMODE_BUFFER;
#else
goto not_there;
#endif
if (strEQ(name, "CTRL_BREAK_EVENT"))
#ifdef CTRL_BREAK_EVENT
return CTRL_BREAK_EVENT;
#else
goto not_there;
#endif
if (strEQ(name, "CTRL_C_EVENT"))
#ifdef CTRL_C_EVENT
return CTRL_C_EVENT;
#else
goto not_there;
#endif
break;
case 'D':
break;
case 'E':
if (strEQ(name, "ENABLE_ECHO_INPUT"))
#ifdef ENABLE_ECHO_INPUT
return ENABLE_ECHO_INPUT;
#else
goto not_there;
#endif
if (strEQ(name, "ENABLE_LINE_INPUT"))
#ifdef ENABLE_LINE_INPUT
return ENABLE_LINE_INPUT;
#else
goto not_there;
#endif
if (strEQ(name, "ENABLE_MOUSE_INPUT"))
#ifdef ENABLE_MOUSE_INPUT
return ENABLE_MOUSE_INPUT;
#else
goto not_there;
#endif
if (strEQ(name, "ENABLE_PROCESSED_INPUT"))
#ifdef ENABLE_PROCESSED_INPUT
return ENABLE_PROCESSED_INPUT;
#else
goto not_there;
#endif
if (strEQ(name, "ENABLE_PROCESSED_OUTPUT"))
#ifdef ENABLE_PROCESSED_OUTPUT
return ENABLE_PROCESSED_OUTPUT;
#else
goto not_there;
#endif
if (strEQ(name, "ENABLE_WINDOW_INPUT"))
#ifdef ENABLE_WINDOW_INPUT
return ENABLE_WINDOW_INPUT;
#else
goto not_there;
#endif
if (strEQ(name, "ENABLE_WRAP_AT_EOL_OUTPUT"))
#ifdef ENABLE_WRAP_AT_EOL_OUTPUT
return ENABLE_WRAP_AT_EOL_OUTPUT;
#else
goto not_there;
#endif
if (strEQ(name, "ENHANCED_KEY"))
#ifdef ENHANCED_KEY
return ENHANCED_KEY;
#else
goto not_there;
#endif
break;
case 'F':
if (strEQ(name, "FILE_SHARE_READ"))
#ifdef FILE_SHARE_READ
return FILE_SHARE_READ;
#else
goto not_there;
#endif
if (strEQ(name, "FILE_SHARE_WRITE"))
#ifdef FILE_SHARE_WRITE
return FILE_SHARE_WRITE;
#else
goto not_there;
#endif
if (strEQ(name, "FOREGROUND_BLUE"))
#ifdef FOREGROUND_BLUE
return FOREGROUND_BLUE;
#else
goto not_there;
#endif
if (strEQ(name, "FOREGROUND_GREEN"))
#ifdef FOREGROUND_GREEN
return FOREGROUND_GREEN;
#else
goto not_there;
#endif
if (strEQ(name, "FOREGROUND_INTENSITY"))
#ifdef FOREGROUND_INTENSITY
return FOREGROUND_INTENSITY;
#else
goto not_there;
#endif
if (strEQ(name, "FOREGROUND_RED"))
#ifdef FOREGROUND_RED
return FOREGROUND_RED;
#else
goto not_there;
#endif
break;
case 'G':
if (strEQ(name, "GENERIC_READ"))
#ifdef GENERIC_READ
return GENERIC_READ;
#else
goto not_there;
#endif
if (strEQ(name, "GENERIC_WRITE"))
#ifdef GENERIC_WRITE
return GENERIC_WRITE;
#else
goto not_there;
#endif
break;
case 'H':
break;
case 'I':
break;
case 'J':
break;
case 'K':
if (strEQ(name, "KEY_EVENT"))
#ifdef KEY_EVENT
return KEY_EVENT;
#else
goto not_there;
#endif
break;
case 'L':
if (strEQ(name, "LEFT_ALT_PRESSED"))
#ifdef LEFT_ALT_PRESSED
return LEFT_ALT_PRESSED;
#else
goto not_there;
#endif
if (strEQ(name, "LEFT_CTRL_PRESSED"))
#ifdef LEFT_CTRL_PRESSED
return LEFT_CTRL_PRESSED;
#else
goto not_there;
#endif
break;
case 'M':
break;
case 'N':
if (strEQ(name, "NUMLOCK_ON"))
#ifdef NUMLOCK_ON
return NUMLOCK_ON;
#else
goto not_there;
#endif
break;
case 'O':
break;
case 'P':
break;
case 'Q':
break;
case 'R':
if (strEQ(name, "RIGHT_ALT_PRESSED"))
#ifdef RIGHT_ALT_PRESSED
return RIGHT_ALT_PRESSED;
#else
goto not_there;
#endif
if (strEQ(name, "RIGHT_CTRL_PRESSED"))
#ifdef RIGHT_CTRL_PRESSED
return RIGHT_CTRL_PRESSED;
#else
goto not_there;
#endif
break;
case 'S':
if (strEQ(name, "SCROLLLOCK_ON"))
#ifdef SCROLLLOCK_ON
return SCROLLLOCK_ON;
#else
goto not_there;
#endif
if (strEQ(name, "SHIFT_PRESSED"))
#ifdef SHIFT_PRESSED
return SHIFT_PRESSED;
#else
goto not_there;
#endif
if (strEQ(name, "STD_ERROR_HANDLE"))
#ifdef STD_ERROR_HANDLE
return STD_ERROR_HANDLE;
#else
goto not_there;
#endif
if (strEQ(name, "STD_INPUT_HANDLE"))
#ifdef STD_INPUT_HANDLE
return STD_INPUT_HANDLE;
#else
goto not_there;
#endif
if (strEQ(name, "STD_OUTPUT_HANDLE"))
#ifdef STD_OUTPUT_HANDLE
return STD_OUTPUT_HANDLE;
#else
goto not_there;
#endif
break;
case 'T':
break;
case 'U':
break;
case 'V':
break;
case 'W':
break;
case 'X':
break;
case 'Y':
break;
case 'Z':
break;
}
rb_raise(rb_eArgError, "Not such constant.");
return 0;
not_there:
rb_raise(rb_eArgError, "Not defined.");
return 0;
}
int
main(int argc, const char **argv)
{
STR *str;
int i;
STR *tmpstr;
/* char *namelist; */
#ifdef NETWARE
fnInitGpfGlobals(); /* For importing the CLIB calls in place of Watcom calls */
#endif /* NETWARE */
myname = argv[0];
linestr = str_new(80);
for (argc--,argv++; argc; argc--,argv++) {
if (argv[0][0] != '-' || !argv[0][1])
break;
switch (argv[0][1]) {
#ifdef DEBUGGING
case 'D':
debug = atoi(argv[0]+2);
#if YYDEBUG
yydebug = (debug & 1);
#endif
break;
#endif
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
maxfld = atoi(argv[0]+1);
absmaxfld = TRUE;
break;
case 'F':
fswitch = argv[0][2];
break;
case 'n':
namelist = savestr(argv[0]+2);
break;
case 'o':
old_awk = TRUE;
break;
case '-':
argc--,argv++;
goto switch_end;
case 0:
break;
default:
#if defined(OS2) || defined(WIN32) || defined(NETWARE)
fprintf(stderr, "Unrecognized switch: %s\n",argv[0]);
usage();
#else
fatal("Unrecognized switch: %s\n",argv[0]);
#endif
}
}
switch_end:
/* open script */
if (argv[0] == NULL) {
#if defined(OS2) || defined(WIN32) || defined(NETWARE)
if ( isatty(fileno(stdin)) )
usage();
#endif
argv[0] = "-";
}
filename = savestr(argv[0]);
if (strEQ(filename,"-"))
argv[0] = "";
if (!*argv[0])
rsfp = stdin;
else
rsfp = fopen(argv[0],"r");
if (rsfp == NULL)
fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
/* init tokener */
bufptr = str_get(linestr);
symtab = hnew();
curarghash = hnew();
/* now parse the report spec */
if (yyparse())
fatal("Translation aborted due to syntax errors.\n");
#ifdef DEBUGGING
if (debug & 2) {
int type, len;
for (i=1; i<mop;) {
type = ops[i].ival;
len = type >> 8;
type &= 255;
printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]);
if (type == OSTRING)
printf("\t\"%s\"\n",ops[i].cval),i++;
else {
while (len--) {
printf("\t%d",ops[i].ival),i++;
}
putchar('\n');
}
}
}
GV *
Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
{
register const char *nend;
const char *nsplit = 0;
GV* gv;
HV* ostash = stash;
if (stash && SvTYPE(stash) < SVt_PVHV)
stash = Nullhv;
for (nend = name; *nend; nend++) {
if (*nend == '\'')
nsplit = nend;
else if (*nend == ':' && *(nend + 1) == ':')
nsplit = ++nend;
}
if (nsplit) {
const char *origname = name;
name = nsplit + 1;
if (*nsplit == ':')
--nsplit;
if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
/* ->SUPER::method should really be looked up in original stash */
SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
CopSTASHPV(PL_curcop)));
/* __PACKAGE__::SUPER stash should be autovivified */
stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
origname, HvNAME(stash), name) );
}
else {
/* don't autovifify if ->NoSuchStash::method */
stash = gv_stashpvn(origname, nsplit - origname, FALSE);
/* however, explicit calls to Pkg::SUPER::method may
happen, and may require autovivification to work */
if (!stash && (nsplit - origname) >= 7 &&
strnEQ(nsplit - 7, "::SUPER", 7) &&
gv_stashpvn(origname, nsplit - origname - 7, FALSE))
stash = gv_stashpvn(origname, nsplit - origname, TRUE);
}
ostash = stash;
}
gv = gv_fetchmeth(stash, name, nend - name, 0);
if (!gv) {
if (strEQ(name,"import") || strEQ(name,"unimport"))
gv = (GV*)&PL_sv_yes;
else if (autoload)
gv = gv_autoload4(ostash, name, nend - name, TRUE);
}
else if (autoload) {
CV* cv = GvCV(gv);
if (!CvROOT(cv) && !CvXSUB(cv)) {
GV* stubgv;
GV* autogv;
if (CvANON(cv))
stubgv = gv;
else {
stubgv = CvGV(cv);
if (GvCV(stubgv) != cv) /* orphaned import */
stubgv = gv;
}
autogv = gv_autoload4(GvSTASH(stubgv),
GvNAME(stubgv), GvNAMELEN(stubgv), TRUE);
if (autogv)
gv = autogv;
}
}
return gv;
}
static int
intuit_diff_type(void)
{
long this_line = 0, previous_line;
long first_command_line = -1;
LINENUM fcl_line = -1;
bool last_line_was_command = false, this_is_a_command = false;
bool stars_last_line = false, stars_this_line = false;
char *s, *t;
int indent, retval;
struct file_name names[MAX_FILE];
memset(names, 0, sizeof(names));
ok_to_create_file = false;
fseek(pfp, p_base, SEEK_SET);
p_input_line = p_bline - 1;
for (;;) {
previous_line = this_line;
last_line_was_command = this_is_a_command;
stars_last_line = stars_this_line;
this_line = ftell(pfp);
indent = 0;
p_input_line++;
if (pgets(false) == 0) {
if (first_command_line >= 0L) {
/* nothing but deletes!? */
p_start = first_command_line;
p_sline = fcl_line;
retval = ED_DIFF;
goto scan_exit;
} else {
p_start = this_line;
p_sline = p_input_line;
retval = 0;
goto scan_exit;
}
}
for (s = buf; *s == ' ' || *s == '\t' || *s == 'X'; s++) {
if (*s == '\t')
indent += 8 - (indent % 8);
else
indent++;
}
for (t = s; isdigit((unsigned char)*t) || *t == ','; t++)
;
this_is_a_command = (isdigit((unsigned char)*s) &&
(*t == 'd' || *t == 'c' || *t == 'a'));
if (first_command_line < 0L && this_is_a_command) {
first_command_line = this_line;
fcl_line = p_input_line;
p_indent = indent; /* assume this for now */
}
if (!stars_last_line && strnEQ(s, "*** ", 4))
names[OLD_FILE].path = fetchname(s + 4,
&names[OLD_FILE].exists, strippath);
else if (strnEQ(s, "--- ", 4))
names[NEW_FILE].path = fetchname(s + 4,
&names[NEW_FILE].exists, strippath);
else if (strnEQ(s, "+++ ", 4))
/* pretend it is the old name */
names[OLD_FILE].path = fetchname(s + 4,
&names[OLD_FILE].exists, strippath);
else if (strnEQ(s, "Index:", 6))
names[INDEX_FILE].path = fetchname(s + 6,
&names[INDEX_FILE].exists, strippath);
else if (strnEQ(s, "Prereq:", 7)) {
for (t = s + 7; isspace((unsigned char)*t); t++)
;
revision = savestr(t);
for (t = revision; *t && !isspace((unsigned char)*t); t++)
;
*t = '\0';
if (*revision == '\0') {
free(revision);
revision = NULL;
}
} else if (strnEQ(s, "==== ", 5)) {
/* Perforce-style diffs. */
if ((t = strstr(s + 5, " - ")) != NULL)
p4_fetchname(&names[NEW_FILE], t + 3);
p4_fetchname(&names[OLD_FILE], s + 5);
}
if ((!diff_type || diff_type == ED_DIFF) &&
first_command_line >= 0L &&
strEQ(s, ".\n")) {
p_indent = indent;
p_start = first_command_line;
p_sline = fcl_line;
retval = ED_DIFF;
goto scan_exit;
}
if ((!diff_type || diff_type == UNI_DIFF) && strnEQ(s, "@@ -", 4)) {
if (strnEQ(s + 4, "0,0", 3))
ok_to_create_file = true;
p_indent = indent;
p_start = this_line;
p_sline = p_input_line;
retval = UNI_DIFF;
goto scan_exit;
}
stars_this_line = strnEQ(s, "********", 8);
if ((!diff_type || diff_type == CONTEXT_DIFF) && stars_last_line &&
strnEQ(s, "*** ", 4)) {
if (atol(s + 4) == 0)
ok_to_create_file = true;
/*
* If this is a new context diff the character just
* before the newline is a '*'.
*/
while (*s != '\n')
s++;
p_indent = indent;
p_start = previous_line;
p_sline = p_input_line - 1;
retval = (*(s - 1) == '*' ? NEW_CONTEXT_DIFF : CONTEXT_DIFF);
goto scan_exit;
}
if ((!diff_type || diff_type == NORMAL_DIFF) &&
last_line_was_command &&
(strnEQ(s, "< ", 2) || strnEQ(s, "> ", 2))) {
p_start = previous_line;
p_sline = p_input_line - 1;
p_indent = indent;
retval = NORMAL_DIFF;
goto scan_exit;
}
}
scan_exit:
if (retval == UNI_DIFF) {
/* unswap old and new */
struct file_name tmp = names[OLD_FILE];
names[OLD_FILE] = names[NEW_FILE];
names[NEW_FILE] = tmp;
}
if (filearg[0] == NULL) {
if (posix)
filearg[0] = posix_name(names, ok_to_create_file);
else {
/* Ignore the Index: name for context diffs, like GNU */
if (names[OLD_FILE].path != NULL ||
names[NEW_FILE].path != NULL) {
free(names[INDEX_FILE].path);
names[INDEX_FILE].path = NULL;
}
filearg[0] = best_name(names, ok_to_create_file);
}
}
free(bestguess);
bestguess = NULL;
if (filearg[0] != NULL)
bestguess = savestr(filearg[0]);
else if (!ok_to_create_file) {
/*
* We don't want to create a new file but we need a
* filename to set bestguess. Avoid setting filearg[0]
* so the file is not created automatically.
*/
if (posix)
bestguess = posix_name(names, true);
else
bestguess = best_name(names, true);
}
free(names[OLD_FILE].path);
free(names[NEW_FILE].path);
free(names[INDEX_FILE].path);
return retval;
}
void
Perl_mro_isa_changed_in(pTHX_ HV* stash)
{
HV* isarev;
AV* linear_mro;
HE* iter;
SV** svp;
I32 items;
bool is_universal;
struct mro_meta * meta;
HV *isa = NULL;
const HEK * const stashhek = HvENAME_HEK(stash);
const char * const stashname = HvENAME_get(stash);
const STRLEN stashname_len = HvENAMELEN_get(stash);
PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN;
if(!stashname)
Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");
/* wipe out the cached linearizations for this stash */
meta = HvMROMETA(stash);
CLEAR_LINEAR(meta);
if (meta->isa) {
/* Steal it for our own purposes. */
isa = (HV *)sv_2mortal((SV *)meta->isa);
meta->isa = NULL;
}
/* Inc the package generation, since our @ISA changed */
meta->pkg_gen++;
/* Wipe the global method cache if this package
is UNIVERSAL or one of its parents */
svp = hv_fetchhek(PL_isarev, stashhek, 0);
isarev = svp ? MUTABLE_HV(*svp) : NULL;
if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
|| (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
PL_sub_generation++;
is_universal = TRUE;
}
else { /* Wipe the local method cache otherwise */
meta->cache_gen++;
is_universal = FALSE;
}
/* wipe next::method cache too */
if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
/* Changes to @ISA might turn overloading on */
HvAMAGIC_on(stash);
/* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */
HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
/* DESTROY can be cached in SvSTASH. */
if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
/* Iterate the isarev (classes that are our children),
wiping out their linearization, method and isa caches
and upating PL_isarev. */
if(isarev) {
HV *isa_hashes = NULL;
/* We have to iterate through isarev twice to avoid a chicken and
* egg problem: if A inherits from B and both are in isarev, A might
* be processed before B and use B's previous linearisation.
*/
/* First iteration: Wipe everything, but stash away the isa hashes
* since we still need them for updating PL_isarev.
*/
if(hv_iterinit(isarev)) {
/* Only create the hash if we need it; i.e., if isarev has
any elements. */
isa_hashes = (HV *)sv_2mortal((SV *)newHV());
}
while((iter = hv_iternext(isarev))) {
HV* revstash = gv_stashsv(hv_iterkeysv(iter), 0);
struct mro_meta* revmeta;
if(!revstash) continue;
revmeta = HvMROMETA(revstash);
CLEAR_LINEAR(revmeta);
if(!is_universal)
revmeta->cache_gen++;
if(revmeta->mro_nextmethod)
hv_clear(revmeta->mro_nextmethod);
if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL;
(void)
hv_store(
isa_hashes, (const char*)&revstash, sizeof(HV *),
revmeta->isa ? (SV *)revmeta->isa : &PL_sv_undef, 0
);
revmeta->isa = NULL;
}
/* Second pass: Update PL_isarev. We can just use isa_hashes to
* avoid another round of stash lookups. */
/* isarev might be deleted from PL_isarev during this loop, so hang
* on to it. */
SvREFCNT_inc_simple_void_NN(sv_2mortal((SV *)isarev));
if(isa_hashes) {
hv_iterinit(isa_hashes);
while((iter = hv_iternext(isa_hashes))) {
HV* const revstash = *(HV **)HEK_KEY(HeKEY_hek(iter));
HV * const isa = (HV *)HeVAL(iter);
const HEK *namehek;
/* We're starting at the 2nd element, skipping revstash */
linear_mro = mro_get_linear_isa(revstash);
svp = AvARRAY(linear_mro) + 1;
items = AvFILLp(linear_mro);
namehek = HvENAME_HEK(revstash);
if (!namehek) namehek = HvNAME_HEK(revstash);
while (items--) {
SV* const sv = *svp++;
HV* mroisarev;
HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
/* That fetch should not fail. But if it had to create
a new SV for us, then will need to upgrade it to an
HV (which sv_upgrade() can now do for us). */
mroisarev = MUTABLE_HV(HeVAL(he));
SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV);
/* This hash only ever contains PL_sv_yes. Storing it
over itself is almost as cheap as calling hv_exists,
so on aggregate we expect to save time by not making
two calls to the common HV code for the case where
it doesn't exist. */
(void)
hv_storehek(mroisarev, namehek, &PL_sv_yes);
}
if ((SV *)isa != &PL_sv_undef) {
assert(namehek);
mro_clean_isarev(
isa, HEK_KEY(namehek), HEK_LEN(namehek),
HvMROMETA(revstash)->isa, HEK_HASH(namehek),
HEK_UTF8(namehek)
);
}
}
}
}
/* Now iterate our MRO (parents), adding ourselves and everything from
our isarev to their isarev.
*/
/* We're starting at the 2nd element, skipping ourselves here */
linear_mro = mro_get_linear_isa(stash);
svp = AvARRAY(linear_mro) + 1;
items = AvFILLp(linear_mro);
while (items--) {
SV* const sv = *svp++;
HV* mroisarev;
HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
/* That fetch should not fail. But if it had to create a new SV for
us, then will need to upgrade it to an HV (which sv_upgrade() can
now do for us. */
mroisarev = MUTABLE_HV(HeVAL(he));
SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV);
/* This hash only ever contains PL_sv_yes. Storing it over itself is
almost as cheap as calling hv_exists, so on aggregate we expect to
save time by not making two calls to the common HV code for the
case where it doesn't exist. */
(void)hv_storehek(mroisarev, stashhek, &PL_sv_yes);
}
/* Delete our name from our former parents' isarevs. */
if(isa && HvARRAY(isa))
mro_clean_isarev(isa, stashname, stashname_len, meta->isa,
HEK_HASH(stashhek), HEK_UTF8(stashhek));
}
GV *
Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
{
AV* av;
GV* topgv;
GV* gv;
GV** gvp;
CV* cv;
if (!stash)
return 0;
if ((level > 100) || (level < -100))
Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
name, HvNAME(stash));
DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,HvNAME(stash)) );
gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
if (!gvp)
topgv = Nullgv;
else {
topgv = *gvp;
if (SvTYPE(topgv) != SVt_PVGV)
gv_init(topgv, stash, name, len, TRUE);
if ((cv = GvCV(topgv))) {
/* If genuine method or valid cache entry, use it */
if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation)
return topgv;
/* Stale cached entry: junk it */
SvREFCNT_dec(cv);
GvCV(topgv) = cv = Nullcv;
GvCVGEN(topgv) = 0;
}
else if (GvCVGEN(topgv) == PL_sub_generation)
return 0; /* cache indicates sub doesn't exist */
}
gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav;
/* create and re-create @.*::SUPER::ISA on demand */
if (!av || !SvMAGIC(av)) {
char* packname = HvNAME(stash);
STRLEN packlen = strlen(packname);
if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
HV* basestash;
packlen -= 7;
basestash = gv_stashpvn(packname, packlen, TRUE);
gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
if (!gvp || !(gv = *gvp))
Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash));
if (SvTYPE(gv) != SVt_PVGV)
gv_init(gv, stash, "ISA", 3, TRUE);
SvREFCNT_dec(GvAV(gv));
GvAV(gv) = (AV*)SvREFCNT_inc(av);
}
}
}
if (av) {
SV** svp = AvARRAY(av);
/* NOTE: No support for tied ISA */
I32 items = AvFILLp(av) + 1;
while (items--) {
SV* sv = *svp++;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
}
gv = gv_fetchmeth(basestash, name, len,
(level >= 0) ? level + 1 : level - 1);
if (gv)
goto gotcha;
}
}
/* if at top level, try UNIVERSAL */
if (level == 0 || level == -1) {
HV* lastchance;
if ((lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE))) {
if ((gv = gv_fetchmeth(lastchance, name, len,
(level >= 0) ? level + 1 : level - 1)))
{
gotcha:
/*
* Cache method in topgv if:
* 1. topgv has no synonyms (else inheritance crosses wires)
* 2. method isn't a stub (else AUTOLOAD fails spectacularly)
*/
if (topgv &&
GvREFCNT(topgv) == 1 &&
(cv = GvCV(gv)) &&
(CvROOT(cv) || CvXSUB(cv)))
{
if ((cv = GvCV(topgv)))
SvREFCNT_dec(cv);
GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
GvCVGEN(topgv) = PL_sub_generation;
}
return gv;
}
else if (topgv && GvREFCNT(topgv) == 1) {
/* cache the fact that the method is not defined */
GvCVGEN(topgv) = PL_sub_generation;
}
}
}
return 0;
}
static void CallFIMLFitFunction(omxFitFunction *off, int want, FitContext *fc)
{
// TODO: Figure out how to give access to other per-iteration structures.
// TODO: Current implementation is slow: update by filtering correlations and thresholds.
// TODO: Current implementation does not implement speedups for sorting.
// TODO: Current implementation may fail on all-continuous-missing or all-ordinal-missing rows.
if (want & (FF_COMPUTE_PREOPTIMIZE)) return;
if(OMX_DEBUG) {
mxLog("Beginning Joint FIML Evaluation.");
}
int returnRowLikelihoods = 0;
omxFIMLFitFunction* ofiml = ((omxFIMLFitFunction*)off->argStruct);
omxMatrix* fitMatrix = off->matrix;
int numChildren = (int) fc->childList.size();
omxMatrix *cov = ofiml->cov;
omxMatrix *means = ofiml->means;
if (!means) {
omxRaiseErrorf("%s: raw data observed but no expected means "
"vector was provided. Add something like mxPath(from = 'one',"
" to = manifests) to your model.", off->name());
return;
}
omxData* data = ofiml->data; // read-only
omxMatrix *dataColumns = ofiml->dataColumns;
returnRowLikelihoods = ofiml->returnRowLikelihoods; // read-only
omxExpectation* expectation = off->expectation;
std::vector< omxThresholdColumn > &thresholdCols = expectation->thresholds;
if (data->defVars.size() == 0 && !strEQ(expectation->expType, "MxExpectationStateSpace")) {
if(OMX_DEBUG) {mxLog("Precalculating cov and means for all rows.");}
omxExpectationRecompute(fc, expectation);
// MCN Also do the threshold formulae!
for(int j=0; j < dataColumns->cols; j++) {
int var = omxVectorElement(dataColumns, j);
if (!omxDataColumnIsFactor(data, var)) continue;
if (j < int(thresholdCols.size()) && thresholdCols[j].numThresholds > 0) { // j is an ordinal column
omxMatrix* nextMatrix = thresholdCols[j].matrix;
omxRecompute(nextMatrix, fc);
checkIncreasing(nextMatrix, thresholdCols[j].column, thresholdCols[j].numThresholds, fc);
for(int index = 0; index < numChildren; index++) {
FitContext *kid = fc->childList[index];
omxMatrix *target = kid->lookupDuplicate(nextMatrix);
omxCopyMatrix(target, nextMatrix);
}
} else {
Rf_error("No threshold given for ordinal column '%s'",
omxDataColumnName(data, j));
}
}
double *corList = ofiml->corList;
double *weights = ofiml->weights;
if (corList) {
omxStandardizeCovMatrix(cov, corList, weights, fc); // Calculate correlation and covariance
}
for(int index = 0; index < numChildren; index++) {
FitContext *kid = fc->childList[index];
omxMatrix *childFit = kid->lookupDuplicate(fitMatrix);
omxFIMLFitFunction* childOfiml = ((omxFIMLFitFunction*) childFit->fitFunction->argStruct);
omxCopyMatrix(childOfiml->cov, cov);
omxCopyMatrix(childOfiml->means, means);
if (corList) {
memcpy(childOfiml->weights, weights, sizeof(double) * cov->rows);
memcpy(childOfiml->corList, corList, sizeof(double) * (cov->rows * (cov->rows - 1)) / 2);
}
}
if(OMX_DEBUG) { omxPrintMatrix(cov, "Cov"); }
if(OMX_DEBUG) { omxPrintMatrix(means, "Means"); }
}
memset(ofiml->rowLogLikelihoods->data, 0, sizeof(double) * data->rows);
int parallelism = (numChildren == 0) ? 1 : numChildren;
if (parallelism > data->rows) {
parallelism = data->rows;
}
FIMLSingleIterationType singleIter = ofiml->SingleIterFn;
bool failed = false;
if (parallelism > 1) {
int stride = (data->rows / parallelism);
#pragma omp parallel for num_threads(parallelism) reduction(||:failed)
for(int i = 0; i < parallelism; i++) {
FitContext *kid = fc->childList[i];
omxMatrix *childMatrix = kid->lookupDuplicate(fitMatrix);
omxFitFunction *childFit = childMatrix->fitFunction;
if (i == parallelism - 1) {
failed |= singleIter(kid, childFit, off, stride * i, data->rows - stride * i);
} else {
failed |= singleIter(kid, childFit, off, stride * i, stride);
}
}
} else {
failed |= singleIter(fc, off, off, 0, data->rows);
}
if (failed) {
omxSetMatrixElement(off->matrix, 0, 0, NA_REAL);
return;
}
if(!returnRowLikelihoods) {
double val, sum = 0.0;
// floating-point addition is not associative,
// so we serialized the following reduction operation.
for(int i = 0; i < data->rows; i++) {
val = omxVectorElement(ofiml->rowLogLikelihoods, i);
// mxLog("%d , %f, %llx\n", i, val, *((unsigned long long*) &val));
sum += val;
}
if(OMX_DEBUG) {mxLog("Total Likelihood is %3.3f", sum);}
omxSetMatrixElement(off->matrix, 0, 0, sum);
}
}
EXTERN void
parse(pTHX_
PSTATE* p_state,
SV* chunk,
SV* self)
{
char *s, *beg, *end;
U32 utf8 = 0;
STRLEN len;
if (!chunk) {
/* eof */
char empty[1];
if (p_state->buf && SvOK(p_state->buf)) {
/* flush it */
s = SvPV(p_state->buf, len);
end = s + len;
utf8 = SvUTF8(p_state->buf);
assert(len);
while (s < end) {
if (p_state->literal_mode) {
if (strEQ(p_state->literal_mode, "plaintext") && !p_state->closing_plaintext)
break;
p_state->pending_end_tag = p_state->literal_mode;
p_state->literal_mode = 0;
s = parse_buf(aTHX_ p_state, s, end, utf8, self);
continue;
}
if (!p_state->strict_comment && !p_state->no_dash_dash_comment_end && *s == '<') {
p_state->no_dash_dash_comment_end = 1;
s = parse_buf(aTHX_ p_state, s, end, utf8, self);
continue;
}
if (!p_state->strict_comment && *s == '<') {
/* some kind of unterminated markup. Report rest as as comment */
token_pos_t token;
token.beg = s + 1;
token.end = end;
report_event(p_state, E_COMMENT, s, end, utf8, &token, 1, self);
s = end;
}
break;
}
if (s < end) {
/* report rest as text */
report_event(p_state, E_TEXT, s, end, utf8, 0, 0, self);
}
SvREFCNT_dec(p_state->buf);
p_state->buf = 0;
}
if (p_state->pend_text && SvOK(p_state->pend_text))
flush_pending_text(p_state, self);
if (p_state->ignoring_element) {
/* document not balanced */
SvREFCNT_dec(p_state->ignoring_element);
p_state->ignoring_element = 0;
}
report_event(p_state, E_END_DOCUMENT, empty, empty, 0, 0, 0, self);
/* reset state */
p_state->offset = 0;
if (p_state->line)
p_state->line = 1;
p_state->column = 0;
p_state->literal_mode = 0;
p_state->is_cdata = 0;
return;
}
#ifdef UNICODE_HTML_PARSER
if (p_state->utf8_mode)
sv_utf8_downgrade(chunk, 0);
#endif
if (p_state->buf && SvOK(p_state->buf)) {
sv_catsv(p_state->buf, chunk);
beg = SvPV(p_state->buf, len);
utf8 = SvUTF8(p_state->buf);
}
else {
beg = SvPV(chunk, len);
utf8 = SvUTF8(chunk);
if (p_state->offset == 0) {
report_event(p_state, E_START_DOCUMENT, beg, beg, 0, 0, 0, self);
/* Print warnings if we find unexpected Unicode BOM forms */
#ifdef UNICODE_HTML_PARSER
if (DOWARN &&
p_state->argspec_entity_decode &&
!p_state->utf8_mode && (
(!utf8 && len >= 3 && strnEQ(beg, "\xEF\xBB\xBF", 3)) ||
(utf8 && len >= 6 && strnEQ(beg, "\xC3\xAF\xC2\xBB\xC2\xBF", 6)) ||
(!utf8 && probably_utf8_chunk(aTHX_ beg, len))
)
)
{
warn("Parsing of undecoded UTF-8 will give garbage when decoding entities");
}
if (DOWARN && utf8 && len >= 2 && strnEQ(beg, "\xFF\xFE", 2)) {
warn("Parsing string decoded with wrong endianess");
}
#endif
if (DOWARN) {
if (!utf8 && len >= 4 &&
(strnEQ(beg, "\x00\x00\xFE\xFF", 4) ||
strnEQ(beg, "\xFE\xFF\x00\x00", 4))
)
{
warn("Parsing of undecoded UTF-32");
}
else if (!utf8 && len >= 2 &&
(strnEQ(beg, "\xFE\xFF", 2) || strnEQ(beg, "\xFF\xFE", 2))
)
{
warn("Parsing of undecoded UTF-16");
}
}
}
}
if (!len)
return; /* nothing to do */
end = beg + len;
s = parse_buf(aTHX_ p_state, beg, end, utf8, self);
if (s == end || p_state->eof) {
if (p_state->buf) {
SvOK_off(p_state->buf);
}
}
else {
/* need to keep rest in buffer */
if (p_state->buf) {
/* chop off some chars at the beginning */
if (SvOK(p_state->buf)) {
sv_chop(p_state->buf, s);
}
else {
sv_setpvn(p_state->buf, s, end - s);
if (utf8)
SvUTF8_on(p_state->buf);
else
SvUTF8_off(p_state->buf);
}
}
else {
p_state->buf = newSVpv(s, end - s);
if (utf8)
SvUTF8_on(p_state->buf);
}
}
return;
}
/*
* This is the main function for dumping any node.
*/
SV *
load_node(perl_yaml_loader_t *loader)
{
SV* return_sv = NULL;
/* This uses stack, but avoids (severe!) memory leaks */
yaml_event_t uplevel_event;
uplevel_event = loader->event;
/* Get the next parser event */
if (!yaml_parser_parse(&loader->parser, &loader->event))
goto load_error;
/* These events don't need yaml_event_delete */
/* Some kind of error occurred */
if (loader->event.type == YAML_NO_EVENT)
goto load_error;
/* Return NULL when we hit the end of a scope */
if (loader->event.type == YAML_DOCUMENT_END_EVENT ||
loader->event.type == YAML_MAPPING_END_EVENT ||
loader->event.type == YAML_SEQUENCE_END_EVENT) {
/* restore the uplevel event, so it can be properly deleted */
loader->event = uplevel_event;
return return_sv;
}
/* The rest all need cleanup */
switch (loader->event.type) {
char *tag;
/* Handle loading a mapping */
case YAML_MAPPING_START_EVENT:
tag = (char *)loader->event.data.mapping_start.tag;
/* Handle mapping tagged as a Perl hard reference */
if (tag && strEQ(tag, TAG_PERL_REF)) {
return_sv = load_scalar_ref(loader);
break;
}
/* Handle mapping tagged as a Perl typeglob */
if (tag && strEQ(tag, TAG_PERL_GLOB)) {
return_sv = load_glob(loader);
break;
}
return_sv = load_mapping(loader, NULL);
break;
/* Handle loading a sequence into an array */
case YAML_SEQUENCE_START_EVENT:
return_sv = load_sequence(loader);
break;
/* Handle loading a scalar */
case YAML_SCALAR_EVENT:
return_sv = load_scalar(loader);
break;
/* Handle loading an alias node */
case YAML_ALIAS_EVENT:
return_sv = load_alias(loader);
break;
default:
croak("%sInvalid event '%d' at top level", ERRMSG, (int) loader->event.type);
}
yaml_event_delete(&loader->event);
/* restore the uplevel event, so it can be properly deleted */
loader->event = uplevel_event;
return return_sv;
load_error:
croak("%s", loader_error_msg(loader, NULL));
}
static int load_indexed_hash_module_ex(pTHX_ CBC *THIS, const char **modlist, int num)
{
const char *p = NULL;
int i;
if (THIS->ixhash != NULL)
{
/* a module has already been loaded */
return 1;
}
for (i = 0; i < num; i++)
{
if (modlist[i])
{
SV *sv = newSVpvn("require ", 8);
sv_catpv(sv, CONST_CHAR(modlist[i]));
CT_DEBUG(MAIN, ("trying to require \"%s\"", modlist[i]));
(void) eval_sv(sv, G_DISCARD);
SvREFCNT_dec(sv);
if ((sv = get_sv("@", 0)) != NULL && strEQ(SvPV_nolen(sv), ""))
{
p = modlist[i];
break;
}
if (i == 0)
{
Perl_warn(aTHX_ "Couldn't load %s for member ordering, "
"trying default modules", modlist[i]);
}
CT_DEBUG(MAIN, ("failed: \"%s\"", sv ? SvPV_nolen(sv) : "[NULL]"));
}
}
if (p == NULL)
{
SV *sv = newSVpvn("", 0);
for (i = 1; i < num; i++)
{
if (i > 1)
{
if (i == num-1)
sv_catpvn(sv, " or ", 4);
else
sv_catpvn(sv, ", ", 2);
}
sv_catpv(sv, CONST_CHAR(modlist[i]));
}
Perl_warn(aTHX_ "Couldn't load a module for member ordering "
"(consider installing %s)", SvPV_nolen(sv));
return 0;
}
CT_DEBUG(MAIN, ("using \"%s\" for member ordering", p));
THIS->ixhash = p;
return 1;
}
SV * parse_in_chunks(char * filepath, size_t filesize) {
char *buf;
size_t bytes_read = 0;
int max_buf = 1000;
char *err_msg;
int block = BLOCK_HEADER;
int cur_event_type = 0;
int event_type = 0;
char event_block = 0;
char *brnl, *breq;
AV * data;
AV * datawrapper;
AV * events;
char *line;
char * nl = "\n";
char * eq = "=";
int rewind_pos = 0;
size_t cur_fpos = 0;
SV * pbuf;
SV * pmax_buf;
AV * HANDLERS = get_av("Opsview::Utils::NDOLogsImporter::HANDLERS", 0);
AV * INPUT_DATA_TYPE = get_av("Opsview::Utils::NDOLogsImporter::INPUT_DATA_TYPE", 0);
int init_last_pos;
int init_block;
if ( first_read ) {
if ( ! ( fh = PerlIO_open( filepath, "rb" ) ) ) {
croak("Could not open file: %s\n", strerror(errno));
}
bytes_left = filesize;
init_last_pos = prev_pos = first_read = 0;
init_block = block = BLOCK_HEADER;
} else {
init_block = block = BLOCK_EVENTS;
init_last_pos = prev_pos;
}
read_begin:
brnl = NULL;
breq = NULL;
pbuf = get_sv("Opsview::Utils::NDOLogsImporter::PARSE_BUF", 0);
pmax_buf = get_sv("Opsview::Utils::NDOLogsImporter::MAX_BUF_SIZE", 0);
buf = SvPVX(pbuf);
max_buf = SvIVX(pmax_buf);
if ( max_buf < 1024 * 1024 && ! automated_tests ) {
max_buf = 1024*1024;
SvIV_set( pmax_buf, max_buf );
SvGROW( pbuf, max_buf + 1);
SvCUR_set( pbuf, max_buf);
}
if ( bytes_left > 0 ) {
bytes_read = PerlIO_read(fh, buf + prev_pos, max_buf-prev_pos);
cur_fpos = PerlIO_tell(fh);
if ( bytes_read < 0 ) {
err_msg = strerror(errno);
PerlIO_close( fh );
croak("Could not read file: %s\n", err_msg);
}
bytes_left -= bytes_read;
events = (AV *)sv_2mortal((SV *)newAV());
rewind_pos = last_999(buf+prev_pos, bytes_read);
prev_pos = bytes_read + prev_pos - rewind_pos;
buf[prev_pos] = '\0';
// avg ratio events:file_size = 0.21%
if ( prev_pos > 1000 ) {
av_extend( events, (int)(prev_pos * 0.0021) );
}
for ( line = strtok_r(buf, nl, &brnl); line != NULL; line = strtok_r(NULL, nl, &brnl) )
{
switch(block) {
case BLOCK_HEADER:
{
if ( strEQ(line, "STARTDATADUMP") ) {
block = BLOCK_EVENTS;
}
}
break;
case BLOCK_EVENTS:
{
if ( strEQ(line, "1000") ) { /* NDO_API_ENDDATADUMP */
block = BLOCK_FOOTER;
continue;
}
cur_event_type = atoi(line);
/* ignore events we are not handling */
if ( ! av_exists(HANDLERS, cur_event_type) ) {
block = BLOCK_IGNORE_EVENT;
continue;
}
event_block = BLOCK_EVENT_STARTED;
if ( cur_event_type != event_type ) {
datawrapper = (AV *)sv_2mortal((SV *)newAV());
data = (AV *)sv_2mortal((SV *)newAV());
av_push( events, newSViv( cur_event_type ) );
av_push( datawrapper, newRV( (SV *)data ) );
av_push( events, newRV( (SV *)datawrapper ) );
event_type = cur_event_type;
} else {
data = (AV *)sv_2mortal((SV *)newAV());
av_push( datawrapper, newRV( (SV *)data ) );
}
block = BLOCK_EVENT;
}
break;
case BLOCK_EVENT:
{
if ( strEQ(line, "999") ) { /* NDO_API_ENDDATA */
block = BLOCK_EVENTS;
event_block = BLOCK_EVENT_ENDED;
} else {
char *k;
char *v;
int key;
int key_type = 0;
int v_len = 0;
k = strtok_r(line, eq, &breq);
v = strtok_r(NULL, "\0", &breq);
key = atoi(k);
/* invalid key, skip parsing */
if ( key == 0 ) {
goto remove_invalid;
}
SV ** const k_type = av_fetch(INPUT_DATA_TYPE, key, 0 );
if ( k_type ) {
key_type = SvIVx( *k_type );
}
if ( v ) {
if ( key_type & 1 ) {
v_len = ndo_unescape_buffer( v );
} else {
v_len = strlen(v);
}
}
if ( key_type & 2 ) {
AV * datanstptr;
SV ** const datanst = av_fetch(data, key, 0 );
if ( datanst ) {
datanstptr = (AV *)SvRV( *datanst );
} else {
datanstptr = (AV *)sv_2mortal((SV *)newAV());
av_store( data, key, newRV( (SV *)datanstptr ) );
}
if ( v ) {
av_push( datanstptr, newSVpvn(v, v_len) );
} else {
av_push( datanstptr, newSVpvn("", 0) );
}
} else {
if ( v ) {
av_store( data, key, newSVpvn(v, v_len) );
} else {
av_store( data, key, newSVpvn("", 0) );
}
}
}
}
break;
case BLOCK_FOOTER:
{
if ( strEQ(line, "GOODBYE") ) {
block = BLOCK_HEADER;
}
}
break;
case BLOCK_IGNORE_EVENT:
{
if ( strEQ(line, "999") ) { /* NDO_API_ENDDATA */
block = BLOCK_EVENTS; // go back to EVENTS
continue;
}
}
break;
}
};
/* there were some events */
if ( event_block != BLOCK_HEADER ) {
if ( event_block != BLOCK_EVENT_ENDED ) {
remove_invalid:
av_pop( datawrapper );
}
/* remove whole block if the last block has no events */
if ( av_len( datawrapper ) == -1 ) {
av_pop( events );
av_pop( events );
}
}
if ( av_len(events) > 0 ) {
if ( rewind_pos > 0 && cur_fpos < filesize ) {
memmove(buf, buf+prev_pos+1, rewind_pos-1);
}
prev_pos = rewind_pos - 1;
return newRV_inc((SV *) events);
} else {
if ( cur_fpos < filesize && event_block != BLOCK_HEADER && event_block != BLOCK_EVENT_ENDED ) {
int new_max_buf = max_buf * 2;
SvIV_set( pmax_buf, new_max_buf );
SvGROW( pbuf, new_max_buf + 1);
SvCUR_set( pbuf, new_max_buf);
//start again as previous buffer would be tokenized already
prev_pos = 0;
block = init_block;
event_type = 0;
PerlIO_close( fh );
if ( ! ( fh = PerlIO_open( filepath, "rb" ) ) ) {
croak("Could not re-open file: %s\n", strerror(errno));
}
PerlIO_seek(fh, cur_fpos-bytes_read-init_last_pos, SEEK_SET);
bytes_left += bytes_read + init_last_pos;
goto read_begin;
}
}
}
parser_reset_iterator();
return &PL_sv_undef;
}
/*
=for apidoc mro_isa_changed_in
Takes the necessary steps (cache invalidations, mostly)
when the @ISA of the given package has changed. Invoked
by the C<setisa> magic, should not need to invoke directly.
=cut
*/
void
Perl_mro_isa_changed_in(pTHX_ HV* stash)
{
dVAR;
HV* isarev;
AV* linear_mro;
HE* iter;
SV** svp;
I32 items;
bool is_universal;
struct mro_meta * meta;
const char * const stashname = HvNAME_get(stash);
const STRLEN stashname_len = HvNAMELEN_get(stash);
PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN;
if(!stashname)
Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");
/* wipe out the cached linearizations for this stash */
meta = HvMROMETA(stash);
if (meta->mro_linear_dfs) {
SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_dfs));
meta->mro_linear_dfs = NULL;
/* This is just acting as a shortcut pointer. */
meta->mro_linear_c3 = NULL;
} else if (meta->mro_linear_c3) {
/* Only the current MRO is stored, so this owns the data. */
SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_c3));
meta->mro_linear_c3 = NULL;
}
if (meta->isa) {
SvREFCNT_dec(meta->isa);
meta->isa = NULL;
}
/* Inc the package generation, since our @ISA changed */
meta->pkg_gen++;
/* Wipe the global method cache if this package
is UNIVERSAL or one of its parents */
svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
isarev = svp ? MUTABLE_HV(*svp) : NULL;
if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
|| (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
PL_sub_generation++;
is_universal = TRUE;
}
else { /* Wipe the local method cache otherwise */
meta->cache_gen++;
is_universal = FALSE;
}
/* wipe next::method cache too */
if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
/* Iterate the isarev (classes that are our children),
wiping out their linearization, method and isa caches */
if(isarev) {
hv_iterinit(isarev);
while((iter = hv_iternext(isarev))) {
I32 len;
const char* const revkey = hv_iterkey(iter, &len);
HV* revstash = gv_stashpvn(revkey, len, 0);
struct mro_meta* revmeta;
if(!revstash) continue;
revmeta = HvMROMETA(revstash);
if (revmeta->mro_linear_dfs) {
SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_dfs));
revmeta->mro_linear_dfs = NULL;
/* This is just acting as a shortcut pointer. */
revmeta->mro_linear_c3 = NULL;
} else if (revmeta->mro_linear_c3) {
/* Only the current MRO is stored, so this owns the data. */
SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_c3));
revmeta->mro_linear_c3 = NULL;
}
if(!is_universal)
revmeta->cache_gen++;
if(revmeta->mro_nextmethod)
hv_clear(revmeta->mro_nextmethod);
if (revmeta->isa) {
SvREFCNT_dec(revmeta->isa);
revmeta->isa = NULL;
}
}
}
/* Now iterate our MRO (parents), and do a few things:
1) instantiate with the "fake" flag if they don't exist
2) flag them as universal if we are universal
3) Add everything from our isarev to their isarev
*/
/* We're starting at the 2nd element, skipping ourselves here */
linear_mro = mro_get_linear_isa(stash);
svp = AvARRAY(linear_mro) + 1;
items = AvFILLp(linear_mro);
while (items--) {
SV* const sv = *svp++;
HV* mroisarev;
HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
/* That fetch should not fail. But if it had to create a new SV for
us, then we can detect it, because it will not be the correct type.
Probably faster and cleaner for us to free that scalar [very little
code actually executed to free it] and create a new HV than to
copy&paste [SIN!] the code from newHV() to allow us to upgrade the
new SV from SVt_NULL. */
mroisarev = MUTABLE_HV(HeVAL(he));
if(SvTYPE(mroisarev) != SVt_PVHV) {
SvREFCNT_dec(mroisarev);
mroisarev = newHV();
HeVAL(he) = MUTABLE_SV(mroisarev);
}
/* This hash only ever contains PL_sv_yes. Storing it over itself is
almost as cheap as calling hv_exists, so on aggregate we expect to
save time by not making two calls to the common HV code for the
case where it doesn't exist. */
(void)hv_store(mroisarev, stashname, stashname_len, &PL_sv_yes, 0);
if(isarev) {
hv_iterinit(isarev);
while((iter = hv_iternext(isarev))) {
I32 revkeylen;
char* const revkey = hv_iterkey(iter, &revkeylen);
(void)hv_store(mroisarev, revkey, revkeylen, &PL_sv_yes, 0);
}
}
}
}
/*
* Function to do a complete selection screen
*/
int iSelect_Browser(int wYSize, int wXSize, int wYPos, int wXPos, int selectpos, int multiselect,
int sYSize, int sXSize, int sYPos, int sXPos, char *title, char *name,
int mYSize, int mXSize, int mYPos, int mXPos,
char **keystr, char *tagbegin, char *tagend)
{
WINDOW *wField;
WINDOW *sField;
WINDOW *mField;
WINDOW *hField;
int i;
int nFirstLine, nLastLine; /* first & last line in buffer */
int nAbsFirstLine, nAbsLastLine; /* first & last line of output buffer */
int nRelMarked; /* relative line inside output buffer of marked line */
int nRelFirstDraw, nRelLastDraw; /* relative first & last line inside output buffer */
int c;
int bEOI;
int bQuit = FALSE;
int y;
int x;
char msg[1024];
char ca[1024];
char ca3[1024];
char *cp;
char *cp2;
char *cp3;
char **cpp;
int ok;
int bAllowEmpty;
/*
* Browser field
*/
wField = newwin(wYSize, wXSize, wYPos, wXPos);
werase(wField);
crmode();
noecho();
keypad(wField, TRUE);
scrollok(wField, FALSE);
/*
* Status field
*/
sField = newwin(sYSize, sXSize, sYPos, sXPos);
werase(sField);
strcpy(msg, "");
/*
* Message field
*/
mField = newwin(mYSize, mXSize, mYPos, mXPos);
werase(mField);
/* dimension of file */
nFirstLine = 0;
nLastLine = nLines-1;
/* determine curses select position */
if (selectpos < -1)
selectpos = -1;
if (selectpos > nLastLine)
selectpos = nLastLine;
if (selectpos == -1) {
selectpos = 0;
/* search for first selectable line */
for (i = nFirstLine; i < nLastLine; i++) {
if (spaLines[i]->fSelectable) {
selectpos = i;
break;
}
}
}
/* calculate browser view borders */
if (nLastLine < (wYSize-1)) {
/* buffer has fewer lines then our browser window */
nAbsFirstLine = nFirstLine;
nAbsLastLine = nLastLine;
nRelFirstDraw = 0;
nRelLastDraw = nLastLine-nFirstLine;
nRelMarked = selectpos;
}
else {
/* browser window is smaller then file */
/* find top view position, so adjust the
cursor into the middle of the browser window */
y = selectpos - (int)((wYSize-1)/2);
if (y <= 0)
y = 0;
if (y+(wYSize-1) > nLastLine)
y = nLastLine-(wYSize-1);
nAbsFirstLine = y;
nAbsLastLine = y+(wYSize-1);
nRelFirstDraw = 0;
nRelLastDraw = (wYSize-1);
nRelMarked = selectpos-y;
}
ok = FALSE;
for (i = nFirstLine; i < nLastLine; i++) {
if (spaLines[i]->fSelectable) {
ok = TRUE;
break;
}
}
if (!ok)
strcpy(msg, "WARNING! No lines selectable.");
bEOI = FALSE;
while (bEOI == FALSE) {
iSelect_Draw(wField,
wYSize, wXSize, wYPos, wXPos,
nAbsFirstLine, nAbsLastLine,
nRelMarked,
nRelFirstDraw, nRelLastDraw,
nLines,
sField, title, name,
mField, msg,
tagbegin, tagend);
wrefresh(wField);
strcpy(msg, "");
c = wgetch(wField);
*keystr = key2asc(c);
c = do_custom_key(c);
if (c == KEY_LEFT)
c = 'q';
if (c == KEY_RIGHT)
c = '\n';
if (c >= KEY_MIN && c <= KEY_MAX) {
/*
* a curses special function key
*/
if (c == KEY_DOWN) {
if (nAbsFirstLine+nRelMarked < nAbsLastLine) {
nRelMarked++;
/* nRelFirstDraw=nRelMarked-1; !!OPTIMIZE!! */
/* nRelLastDraw=nRelMarked; !!OPTIMIZE!! */
}
else {
if (nAbsLastLine < nLastLine) {
wscrl(wField, 1);
nAbsFirstLine++;
nAbsLastLine++;
/* nRelFirstDraw=(wYSize-1); !!OPTIMIZE!! */
/* nRelLastDraw=(wYSize-1); !!OPTIMIZE!!*/
}
else {
strcpy(msg, "Already at End.");
}
}
}
else if (c == KEY_UP) {
if (nRelMarked > 0) {
nRelMarked--;
/* nRelLastDraw=nRelMarked; !!OPTIMIZE!! */
/* nRelFirstDraw=nRelMarked+1; !!OPTIMIZE!! */
}
else {
if (nAbsFirstLine > nFirstLine) {
wscrl(wField, -1);
nAbsFirstLine--;
nAbsLastLine--;
/* nRelFirstDraw=0 !!OPTIMIZE!! */
/* nRelLastDraw=0; !!OPTIMIZE!! */
}
else {
strcpy(msg, "Already at Begin.");
}
}
}
else if (c == KEY_NPAGE) {
if (nAbsFirstLine+nRelMarked == nLastLine) {
strcpy(msg, "Already at End.");
}
else {
for (i = 0; i < (wYSize-1); i++) {
if (nAbsFirstLine+nRelMarked < nAbsLastLine)
nRelMarked++;
else {
if (nAbsLastLine < nLastLine) {
wscrl(wField, 1);
nAbsFirstLine++;
nAbsLastLine++;
}
}
}
}
}
else if (c == KEY_PPAGE) {
if (nAbsFirstLine+nRelMarked == nFirstLine) {
strcpy(msg, "Already at Begin.");
}
else {
for (i = 0; i < (wYSize-1); i++) {
if (nRelMarked > 0)
nRelMarked--;
else {
if (nAbsFirstLine > nFirstLine) {
wscrl(wField, -1);
nAbsFirstLine--;
nAbsLastLine--;
}
}
}
}
}
else {
strcpy(msg, "Invalid special key. Press 'h' for Help Page!");
}
}
else {
c = c & 0xff; /* strip down to 8bit */
if (c < 32 || c > 126) {
/*
* a control code
*/
if (c == '\n' || c == '\r') { /* RETURN */
if (spaLines[nAbsFirstLine+nRelMarked]->fSelectable) {
spaLines[nAbsFirstLine+nRelMarked]->fSelected = TRUE;
bEOI = TRUE;
}
else {
if (multiselect) {
for (i = 0; i < nLines; i++) {
if (spaLines[i]->fSelected) {
bEOI = TRUE;
break;
}
}
if (!bEOI)
strcpy(msg, "Line not selectable and still no others selected.");
}
else {
strcpy(msg, "Line not selectable.");
}
}
/* additionally ask for query strings */
if (bEOI == TRUE) {
cp = spaLines[nAbsFirstLine+nRelMarked]->cpResult;
cp2 = ca;
while (bEOI == TRUE && *cp != NUL) {
if (strnEQ(cp, "%[", 2)) {
cp += 2;
for (cp3 = cp; !strniEQ(cp3, "]s", 2); cp3++)
;
strncpy(ca3, cp, cp3-cp);
ca3[cp3-cp] = NUL;
cp = cp3+1;
if (*cp == 's')
bAllowEmpty = TRUE;
else
bAllowEmpty = FALSE;
cp++;
sprintf(msg, "%s: ", ca3);
iSelect_Draw(wField, wYSize, wXSize, wYPos, wXPos, nAbsFirstLine, nAbsLastLine, -1, nRelFirstDraw, nRelLastDraw, nLines, sField, title, name, mField, msg, tagbegin, tagend);
wrefresh(wField);
cp3 = iSelect_InputField(mYSize, mXSize-strlen(msg), mYPos, mXPos+strlen(msg), bAllowEmpty);
if (strEQ(cp3, "ESC")) {
bEOI = FALSE;
spaLines[nAbsFirstLine+nRelMarked]->fSelected = FALSE;
strcpy(msg, "Selection cancelled.");
continue;
}
strcpy(msg, "");
strcpy(cp2, cp3);
cp2 += strlen(cp3);
}
else {
*cp2++ = *cp++;
}
}
if (bEOI == TRUE) {
*cp2 = NUL;
if (strNE(spaLines[nAbsFirstLine+nRelMarked]->cpResult, ca))
spaLines[nAbsFirstLine+nRelMarked]->cpResult = strdup(ca);
}
}
}
}
if (c >= 32 && c <= 126) {
/*
* a printable character
*/
if (c == ' ') {
if (multiselect) {
if (spaLines[nAbsFirstLine+nRelMarked]->fSelectable) {
if (spaLines[nAbsFirstLine+nRelMarked]->fSelected == FALSE)
spaLines[nAbsFirstLine+nRelMarked]->fSelected = TRUE;
else
spaLines[nAbsFirstLine+nRelMarked]->fSelected = FALSE;
}
else {
strcpy(msg, "Line not selectable.");
}
}
else {
strcpy(msg, "No multi-line selection allowed.");
}
}
else if (c == 'q') {
bEOI = TRUE;
bQuit = TRUE;
}
else if (c == 'g') {
if (nAbsFirstLine+nRelMarked == nFirstLine) {
strcpy(msg, "Already at Begin.");
}
else {
if (nLastLine < (wYSize-1)) {
nAbsFirstLine = nFirstLine;
nAbsLastLine = nLastLine;
nRelFirstDraw = 0;
nRelLastDraw = nLastLine-nFirstLine;
nRelMarked = 0;
}
else {
nAbsFirstLine = nFirstLine;
nAbsLastLine = nFirstLine+(wYSize-1);
nRelFirstDraw = 0;
nRelLastDraw = (wYSize-1);
nRelMarked = 0;
}
}
}
else if (c == 'G') {
if (nAbsFirstLine+nRelMarked == nLastLine) {
strcpy(msg, "Already at End.");
}
else {
if (nLastLine < (wYSize-1)) {
nAbsFirstLine = nFirstLine;
nAbsLastLine = nLastLine;
nRelFirstDraw = 0;
nRelLastDraw = nLastLine-nFirstLine;
nRelMarked = nLastLine-nFirstLine;
}
else {
nAbsFirstLine = nLastLine-(wYSize-1);
nAbsLastLine = nLastLine;
nRelFirstDraw = 0;
nRelLastDraw = (wYSize-1);
nRelMarked = (wYSize-1);
}
}
}
else if (c == 'h' || c == 'v') {
if (c == 'h')
strcpy(msg, "Help Page: Press 'q' to exit");
else
strcpy(msg, "Version Page: Press 'q' to exit");
iSelect_Draw(wField, wYSize, wXSize, wYPos, wXPos, nAbsFirstLine, nAbsLastLine, nRelMarked, nRelFirstDraw, nRelLastDraw, nLines, sField, title, name, mField, msg, tagbegin, tagend);
wrefresh(wField);
hField = newwin(wYSize, wXSize, wYPos, wXPos);
werase(hField);
if (c == 'h')
cpp = iSelect_Help;
else
cpp = iSelect_README;
for (y = 0; y < wYSize && cpp[y] != NULL; y++) {
sprintf(ca, cpp[y]);
cp = ca;
x = 0;
while (1) {
if ((cp2 = strstr(cp, "<b>")) != NULL) {
*cp2 = NUL;
wmove(hField, y, x); waddstr(hField, cp); x += strlen(cp);
wattrset(hField, A_NORMAL|A_BOLD);
cp = cp2+3;
cp2 = strstr(cp, "</b>");
*cp2 = NUL;
wmove(hField, y, x); waddstr(hField, cp); x += strlen(cp);
wattrset(hField, A_NORMAL);
cp = cp2+4;
}
else {
wmove(hField, y, x); waddstr(hField, cp);
break;
}
}
}
wrefresh(hField);
while (1) {
c = wgetch(wField);
c = c & 0xff; /* strip down to 8bit */
if (c == 'q')
break;
}
delwin(hField);
nRelFirstDraw = 0;
nRelLastDraw = nAbsLastLine-nAbsFirstLine;
strcpy(msg, "");
iSelect_Draw(wField, wYSize, wXSize, wYPos, wXPos, nAbsFirstLine, nAbsLastLine, nRelMarked, nRelFirstDraw, nRelLastDraw, nLines, sField, title, name, mField, msg, tagbegin, tagend);
#ifndef USE_SLCURSES
redrawwin(wField);
#endif
wrefresh(wField);
}
else {
strcpy(msg, "Invalid key. Press 'h' for Help Page!");
}
}
}
}
fflush(stdin);
echo();
#ifndef USE_SLCURSES
nocrmode();
#endif
delwin(wField);
if (bQuit)
return(-1);
else
return(nAbsFirstLine+nRelMarked);
}
void
Perl_taint_env(pTHX)
{
SV** svp;
MAGIC* mg;
char** e;
static char* misc_env[] = {
"IFS", /* most shells' inter-field separators */
"CDPATH", /* ksh dain bramage #1 */
"ENV", /* ksh dain bramage #2 */
"BASH_ENV", /* bash dain bramage -- I guess it's contagious */
NULL
};
/* Don't bother if there's no *ENV glob */
if (!PL_envgv)
return;
/* If there's no %ENV hash of if it's not magical, croak, because
* it probably doesn't reflect the actual environment */
if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
&& mg_find((SV*)GvHV(PL_envgv), PERL_MAGIC_env))) {
bool was_tainted = PL_tainted;
char *name = GvENAME(PL_envgv);
PL_tainted = TRUE;
if (strEQ(name,"ENV"))
/* hash alias */
taint_proper("%%ENV is aliased to %s%s", "another variable");
else
/* glob alias: report it in the error message */
taint_proper("%%ENV is aliased to %%%s%s", name);
/* this statement is reached under -t or -U */
PL_tainted = was_tainted;
}
#ifdef VMS
{
int i = 0;
char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
while (1) {
if (i)
(void)sprintf(name,"DCL$PATH;%d", i);
svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE);
if (!svp || *svp == &PL_sv_undef)
break;
if (SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
}
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
}
i++;
}
}
#endif /* VMS */
svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
if (svp && *svp) {
if (SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure %s%s", "$ENV{PATH}");
}
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
}
}
#ifndef VMS
/* tainted $TERM is okay if it contains no metachars */
svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
STRLEN n_a;
bool was_tainted = PL_tainted;
char *t = SvPV(*svp, n_a);
char *e = t + n_a;
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
while (t < e && (isALNUM(*t) || strchr("-_.+", *t)))
t++;
if (t < e) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", "TERM");
}
}
#endif /* !VMS */
for (e = misc_env; *e; e++) {
svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", *e);
}
}
}
void omxInitWLSFitFunction(omxFitFunction* oo) {
omxMatrix *cov, *means, *weights;
if(OMX_DEBUG) { mxLog("Initializing WLS FitFunction function."); }
int vectorSize = 0;
omxSetWLSFitFunctionCalls(oo);
if(OMX_DEBUG) { mxLog("Retrieving expectation.\n"); }
if (!oo->expectation) { Rf_error("%s requires an expectation", oo->fitType); }
if(OMX_DEBUG) { mxLog("Retrieving data.\n"); }
omxData* dataMat = oo->expectation->data;
if (dataMat->hasDefinitionVariables()) Rf_error("%s: def vars not implemented", oo->name());
if(!strEQ(omxDataType(dataMat), "acov") && !strEQ(omxDataType(dataMat), "cov")) {
char *errstr = (char*) calloc(250, sizeof(char));
sprintf(errstr, "WLS FitFunction unable to handle data type %s. Data must be of type 'acov'.\n", omxDataType(dataMat));
omxRaiseError(errstr);
free(errstr);
if(OMX_DEBUG) { mxLog("WLS FitFunction unable to handle data type %s. Aborting.", omxDataType(dataMat)); }
return;
}
omxWLSFitFunction *newObj = (omxWLSFitFunction*) R_alloc(1, sizeof(omxWLSFitFunction));
OMXZERO(newObj, 1);
oo->argStruct = (void*)newObj;
oo->units = FIT_UNITS_SQUARED_RESIDUAL;
/* Get Expectation Elements */
newObj->expectedCov = omxGetExpectationComponent(oo->expectation, "cov");
newObj->expectedMeans = omxGetExpectationComponent(oo->expectation, "means");
// FIXME: threshold structure should be asked for by omxGetExpectationComponent
/* Read and set expected means, variances, and weights */
cov = omxDataCovariance(dataMat);
means = omxDataMeans(dataMat);
weights = omxDataAcov(dataMat);
newObj->observedCov = cov;
newObj->observedMeans = means;
newObj->weights = weights;
newObj->n = omxDataNumObs(dataMat);
// NOTE: If there are any continuous columns then these vectors
// will not match because eThresh is indexed by column number
// not by ordinal column number.
std::vector< omxThresholdColumn > &oThresh = omxDataThresholds(oo->expectation->data);
std::vector< omxThresholdColumn > &eThresh = oo->expectation->thresholds;
// Error Checking: Observed/Expected means must agree.
// ^ is XOR: true when one is false and the other is not.
if((newObj->expectedMeans == NULL) ^ (newObj->observedMeans == NULL)) {
if(newObj->expectedMeans != NULL) {
omxRaiseError("Observed means not detected, but an expected means matrix was specified.\n If you wish to model the means, you must provide observed means.\n");
return;
} else {
omxRaiseError("Observed means were provided, but an expected means matrix was not specified.\n If you provide observed means, you must specify a model for the means.\n");
return;
}
}
if((eThresh.size()==0) ^ (oThresh.size()==0)) {
if (eThresh.size()) {
omxRaiseError("Observed thresholds not detected, but an expected thresholds matrix was specified.\n If you wish to model the thresholds, you must provide observed thresholds.\n ");
return;
} else {
omxRaiseError("Observed thresholds were provided, but an expected thresholds matrix was not specified.\nIf you provide observed thresholds, you must specify a model for the thresholds.\n");
return;
}
}
/* Error check weight matrix size */
int ncol = newObj->observedCov->cols;
vectorSize = (ncol * (ncol + 1) ) / 2;
if(newObj->expectedMeans != NULL) {
vectorSize = vectorSize + ncol;
}
for(int i = 0; i < int(oThresh.size()); i++) {
vectorSize = vectorSize + oThresh[i].numThresholds;
}
if(OMX_DEBUG) { mxLog("Intial WLSFitFunction vectorSize comes to: %d.", vectorSize); }
if(weights != NULL && (weights->rows != weights->cols || weights->cols != vectorSize)) {
omxRaiseError("Developer Error in WLS-based FitFunction object: WLS-based expectation specified an incorrectly-sized weight matrix.\nIf you are not developing a new expectation type, you should probably post this to the OpenMx forums.");
return;
}
// FIXME: More Rf_error checking for incoming Fit Functions
/* Temporary storage for calculation */
newObj->observedFlattened = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->expectedFlattened = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->standardExpectedFlattened = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->P = omxInitMatrix(1, vectorSize, TRUE, oo->matrix->currentState);
newObj->B = omxInitMatrix(vectorSize, 1, TRUE, oo->matrix->currentState);
newObj->standardExpectedCov = omxInitMatrix(ncol, ncol, TRUE, oo->matrix->currentState);
if (oo->expectation->thresholdsMat) {
newObj->standardExpectedThresholds = omxInitMatrix(oo->expectation->thresholdsMat->rows, oo->expectation->thresholdsMat->cols, TRUE, oo->matrix->currentState);
}
if(means){
newObj->standardExpectedMeans = omxInitMatrix(1, ncol, TRUE, oo->matrix->currentState);
}
omxMatrix *obsThresholdsMat = oo->expectation->data->obsThresholdsMat;
flattenDataToVector(newObj->observedCov, newObj->observedMeans, obsThresholdsMat, oThresh, newObj->observedFlattened);
flattenDataToVector(newObj->expectedCov, newObj->expectedMeans, oo->expectation->thresholdsMat,
eThresh, newObj->expectedFlattened);
}
static char*
parse_buf(pTHX_ PSTATE* p_state, char *beg, char *end, U32 utf8, SV* self)
{
char *s = beg;
char *t = beg;
char *new_pos;
while (!p_state->eof) {
/*
* At the start of this loop we will always be ready for eating text
* or a new tag. We will never be inside some tag. The 't' points
* to where we started and the 's' is advanced as we go.
*/
while (p_state->literal_mode) {
char *l = p_state->literal_mode;
bool skip_quoted_end = (strEQ(l, "script") || strEQ(l, "style"));
char inside_quote = 0;
bool escape_next = 0;
char *end_text;
while (s < end) {
if (*s == '<' && !inside_quote)
break;
if (skip_quoted_end) {
if (escape_next) {
escape_next = 0;
}
else {
if (*s == '\\')
escape_next = 1;
else if (inside_quote && *s == inside_quote)
inside_quote = 0;
else if (*s == '\r' || *s == '\n')
inside_quote = 0;
else if (!inside_quote && (*s == '"' || *s == '\''))
inside_quote = *s;
}
}
s++;
}
if (s == end) {
s = t;
goto DONE;
}
end_text = s;
s++;
/* here we rely on '\0' termination of perl svpv buffers */
if (*s == '/') {
s++;
while (*l && toLOWER(*s) == *l) {
s++;
l++;
}
if (!*l && (strNE(p_state->literal_mode, "plaintext") || p_state->closing_plaintext)) {
/* matched it all */
token_pos_t end_token;
end_token.beg = end_text + 2;
end_token.end = s;
while (isHSPACE(*s))
s++;
if (*s == '>') {
s++;
if (t != end_text)
report_event(p_state, E_TEXT, t, end_text, utf8,
0, 0, self);
report_event(p_state, E_END, end_text, s, utf8,
&end_token, 1, self);
p_state->literal_mode = 0;
p_state->is_cdata = 0;
t = s;
}
}
}
}
#ifdef MARKED_SECTION
while (p_state->ms == MS_CDATA || p_state->ms == MS_RCDATA) {
while (s < end && *s != ']')
s++;
if (*s == ']') {
char *end_text = s;
s++;
if (*s == ']') {
s++;
if (*s == '>') {
s++;
/* marked section end */
if (t != end_text)
report_event(p_state, E_TEXT, t, end_text, utf8,
0, 0, self);
report_event(p_state, E_NONE, end_text, s, utf8, 0, 0, self);
t = s;
SvREFCNT_dec(av_pop(p_state->ms_stack));
marked_section_update(p_state);
continue;
}
}
}
if (s == end) {
s = t;
goto DONE;
}
}
#endif
/* first we try to match as much text as possible */
while (s < end && *s != '<') {
#ifdef MARKED_SECTION
if (p_state->ms && *s == ']') {
char *end_text = s;
s++;
if (*s == ']') {
s++;
if (*s == '>') {
s++;
report_event(p_state, E_TEXT, t, end_text, utf8,
0, 0, self);
report_event(p_state, E_NONE, end_text, s, utf8,
0, 0, self);
t = s;
SvREFCNT_dec(av_pop(p_state->ms_stack));
marked_section_update(p_state);
continue;
}
}
}
#endif
s++;
}
if (s != t) {
if (*s == '<') {
report_event(p_state, E_TEXT, t, s, utf8, 0, 0, self);
t = s;
}
else {
s--;
if (isHSPACE(*s)) {
/* wait with white space at end */
while (s >= t && isHSPACE(*s))
s--;
}
else {
/* might be a chopped up entities/words */
while (s >= t && !isHSPACE(*s))
s--;
while (s >= t && isHSPACE(*s))
s--;
}
s++;
if (s != t)
report_event(p_state, E_TEXT, t, s, utf8, 0, 0, self);
break;
}
}
if (end - s < 3)
break;
/* next char is known to be '<' and pointed to by 't' as well as 's' */
s++;
#ifdef USE_PFUNC
new_pos = parsefunc[(unsigned char)*s](p_state, t, end, utf8, self);
#else
if (isHNAME_FIRST(*s))
new_pos = parse_start(p_state, t, end, utf8, self);
else if (*s == '/')
new_pos = parse_end(p_state, t, end, utf8, self);
else if (*s == '!')
new_pos = parse_decl(p_state, t, end, utf8, self);
else if (*s == '?')
new_pos = parse_process(p_state, t, end, utf8, self);
else
new_pos = 0;
#endif /* USE_PFUNC */
if (new_pos) {
if (new_pos == t) {
/* no progress, need more data to know what it is */
s = t;
break;
}
t = s = new_pos;
}
/* if we get out here then this was not a conforming tag, so
* treat it is plain text at the top of the loop again (we
* have already skipped past the "<").
*/
}
DONE:
return s;
}
static int sigar_common_fs_type_get(sigar_file_system_t *fsp)
{
char *type = fsp->sys_type_name;
switch (*type) {
case 'n':
if (strnEQ(type, "nfs", 3)) {
fsp->type = SIGAR_FSTYPE_NETWORK;
}
break;
case 's':
if (strEQ(type, "smbfs")) { /* samba */
fsp->type = SIGAR_FSTYPE_NETWORK;
}
else if (strEQ(type, "swap")) {
fsp->type = SIGAR_FSTYPE_SWAP;
}
break;
case 'a':
if (strEQ(type, "afs")) {
fsp->type = SIGAR_FSTYPE_NETWORK;
}
break;
case 'i':
if (strEQ(type, "iso9660")) {
fsp->type = SIGAR_FSTYPE_CDROM;
}
break;
case 'c':
if (strEQ(type, "cvfs")) {
fsp->type = SIGAR_FSTYPE_LOCAL_DISK;
}
else if (strEQ(type, "cifs")) {
fsp->type = SIGAR_FSTYPE_NETWORK;
}
break;
case 'm':
if (strEQ(type, "msdos") || strEQ(type, "minix")) {
fsp->type = SIGAR_FSTYPE_LOCAL_DISK;
}
break;
case 'h':
if (strEQ(type, "hpfs")) {
fsp->type = SIGAR_FSTYPE_LOCAL_DISK;
}
break;
case 'v':
if (strEQ(type, "vxfs")) {
fsp->type = SIGAR_FSTYPE_LOCAL_DISK;
}
else if (strEQ(type, "vfat")) {
fsp->type = SIGAR_FSTYPE_LOCAL_DISK;
}
break;
case 'z':
if (strEQ(type, "zfs")) {
fsp->type = SIGAR_FSTYPE_LOCAL_DISK;
}
break;
}
return fsp->type;
}
static void bitfields_option(pTHX_ BitfieldLayouter *layouter, SV *sv_val, SV **rval)
{
BitfieldLayouter bl_new = NULL;
BitfieldLayouter bl = *layouter;
if(sv_val)
{
if (SvROK(sv_val))
{
sv_val = SvRV(sv_val);
if (SvTYPE(sv_val) == SVt_PVHV)
{
HV *hv = (HV *) sv_val;
HE *entry;
SV **engine = hv_fetch(hv, "Engine", 6, 0);
int noptions;
const BLOption *options;
if (engine && *engine)
{
const char *name = SvPV_nolen(*engine);
bl = bl_new = bl_create(name);
if (bl_new == NULL)
Perl_croak(aTHX_ "Unknown bitfield layout engine '%s'", name);
}
(void) hv_iterinit(hv);
options = bl->m->options(bl, &noptions);
while ((entry = hv_iternext(hv)) != NULL)
{
SV *value;
I32 keylen;
int i;
const char *prop_string = hv_iterkey(entry, &keylen);
BLProperty prop;
BLPropValue prop_value;
const BLOption *opt = NULL;
enum BLError error;
if (strEQ(prop_string, "Engine"))
continue;
prop = bl_property(prop_string);
for (i = 0; i < noptions; i++)
if (options[i].prop == prop)
{
opt = &options[i];
break;
}
if (opt == NULL)
FAIL_CLEAN((aTHX_ "Invalid option '%s' for bitfield layout engine '%s'",
prop_string, bl->m->class_name(bl)));
value = hv_iterval(hv, entry);
prop_value.type = opt->type;
switch (opt->type)
{
case BLPVT_INT:
prop_value.v.v_int = SvIV(value);
if (opt->nval)
{
const BLPropValInt *pval = opt->pval;
for (i = 0; i < opt->nval; i++)
if (pval[i] == prop_value.v.v_int)
break;
}
break;
case BLPVT_STR:
prop_value.v.v_str = bl_propval(SvPV_nolen(value));
if (opt->nval)
{
const BLPropValStr *pval = opt->pval;
for (i = 0; i < opt->nval; i++)
if (pval[i] == prop_value.v.v_str)
break;
}
break;
default:
fatal("unknown opt->type (%d) in bitfields_option()", opt->type);
break;
}
if (opt->nval && i == opt->nval)
FAIL_CLEAN((aTHX_ "Invalid value '%s' for option '%s'",
SvPV_nolen(value), prop_string));
error = bl->m->set(bl, prop, &prop_value);
switch (error)
{
case BLE_NO_ERROR:
break;
case BLE_INVALID_PROPERTY:
FAIL_CLEAN((aTHX_ "Invalid value '%s' for option '%s'",
SvPV_nolen(value), prop_string));
break;
default:
fatal("unknown error code (%d) returned by set method", error);
break;
}
}
if (bl_new)
{
(*layouter)->m->destroy(*layouter);
*layouter = bl_new;
}
}
else
Perl_croak(aTHX_ "Bitfields wants a hash reference");
}
else
Perl_croak(aTHX_ "Bitfields wants a hash reference");
}
if (rval)
{
int noptions;
const BLOption *opt;
int i;
HV *hv = newHV();
SV *sv = newSVpv(bl->m->class_name(bl), 0);
if (hv_store(hv, "Engine", 6, sv, 0) == NULL)
SvREFCNT_dec(sv);
opt = bl->m->options(bl, &noptions);
for (i = 0; i < noptions; i++, opt++)
{
BLPropValue value;
enum BLError error;
const char *prop_string;
error = bl->m->get(bl, opt->prop, &value);
if (error != BLE_NO_ERROR)
fatal("unexpected error (%d) returned by get method", error);
assert(value.type == opt->type);
switch (opt->type)
{
case BLPVT_INT:
sv = newSViv(value.v.v_int);
break;
case BLPVT_STR:
{
const char *valstr = bl_propval_string(value.v.v_str);
assert(valstr != NULL);
sv = newSVpv(valstr, 0);
}
break;
default:
fatal("unknown opt->type (%d) in bitfields_option()", opt->type);
break;
}
prop_string = bl_property_string(opt->prop);
assert(prop_string != NULL);
if (hv_store(hv, prop_string, strlen(prop_string), sv, 0) == NULL)
SvREFCNT_dec(sv);
}
*rval = newRV_noinc((SV *) hv);
}
}
void
Perl_taint_env(pTHX)
{
SV** svp;
MAGIC* mg;
const char* const *e;
static const char* const misc_env[] = {
"IFS", /* most shells' inter-field separators */
"CDPATH", /* ksh dain bramage #1 */
"ENV", /* ksh dain bramage #2 */
"BASH_ENV", /* bash dain bramage -- I guess it's contagious */
#ifdef WIN32
"PERL5SHELL", /* used for system() on Windows */
#endif
NULL
};
/* Don't bother if there's no *ENV glob */
if (!PL_envgv)
return;
/* If there's no %ENV hash or if it's not magical, croak, because
* it probably doesn't reflect the actual environment */
if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv))
&& mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) {
const bool was_tainted = TAINT_get;
const char * const name = GvENAME(PL_envgv);
TAINT;
if (strEQ(name,"ENV"))
/* hash alias */
taint_proper("%%ENV is aliased to %s%s", "another variable");
else
/* glob alias: report it in the error message */
taint_proper("%%ENV is aliased to %%%s%s", name);
/* this statement is reached under -t or -U */
TAINT_set(was_tainted);
#ifdef NO_TAINT_SUPPORT
PERL_UNUSED_VAR(was_tainted);
#endif
}
#ifdef VMS
{
int i = 0;
char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
STRLEN len = 8; /* strlen(name) */
while (1) {
if (i)
len = my_sprintf(name,"DCL$PATH;%d", i);
svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE);
if (!svp || *svp == &PL_sv_undef)
break;
if (SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure %s%s", "$ENV{DCL$PATH}");
}
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}");
}
i++;
}
}
#endif /* VMS */
svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE);
if (svp && *svp) {
if (SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure %s%s", "$ENV{PATH}");
}
if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) {
TAINT;
taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
}
}
#ifndef VMS
/* tainted $TERM is okay if it contains no metachars */
svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
STRLEN len;
const bool was_tainted = TAINT_get;
const char *t = SvPV_const(*svp, len);
const char * const e = t + len;
TAINT_set(was_tainted);
#ifdef NO_TAINT_SUPPORT
PERL_UNUSED_VAR(was_tainted);
#endif
if (t < e && isWORDCHAR(*t))
t++;
while (t < e && (isWORDCHAR(*t) || strchr("-_.+", *t)))
t++;
if (t < e) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", "TERM");
}
}
#endif /* !VMS */
for (e = misc_env; *e; e++) {
SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", *e);
}
}
}
int ApacheRequest_parse_multipart(ApacheRequest *req)
{
request_rec *r = req->r;
int rc = OK;
const char *ct = ap_table_get(r->headers_in, "Content-Type");
long length;
char *boundary;
multipart_buffer *mbuff;
ApacheUpload *upload = NULL;
if (!ct) {
ap_log_rerror(REQ_ERROR, "[libapreq] no Content-type header!");
return HTTP_INTERNAL_SERVER_ERROR;
}
if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR))) {
return rc;
}
if (!ap_should_client_block(r)) {
return rc;
}
if ((length = r->remaining) > req->post_max && req->post_max > 0) {
ap_log_rerror(REQ_ERROR, "[libapreq] entity too large (%d, max=%d)",
(int)length, req->post_max);
return HTTP_REQUEST_ENTITY_TOO_LARGE;
}
(void)ap_getword(r->pool, &ct, '=');
boundary = ap_getword_conf(r->pool, &ct);
if (!(mbuff = multipart_buffer_new(boundary, length, r))) {
return DECLINED;
}
while (!multipart_buffer_eof(mbuff)) {
table *header = multipart_buffer_headers(mbuff);
const char *cd, *param=NULL, *filename=NULL;
char buff[FILLUNIT];
int blen, wlen;
if (!header) {
#ifdef DEBUG
ap_log_rerror(REQ_ERROR,
"[libapreq] silently drop remaining '%ld' bytes", r->remaining);
#endif
ap_hard_timeout("[libapreq] parse_multipart", r);
while ( ap_get_client_block(r, buff, sizeof(buff)) > 0 )
/* wait for more input to ignore */ ;
ap_kill_timeout(r);
return OK;
}
if ((cd = ap_table_get(header, "Content-Disposition"))) {
const char *pair;
while (*cd && (pair = ap_getword(r->pool, &cd, ';'))) {
const char *key;
while (ap_isspace(*cd)) {
++cd;
}
if (ap_ind(pair, '=')) {
key = ap_getword(r->pool, &pair, '=');
if(strEQ(key, "name")) {
param = ap_getword_conf(r->pool, &pair);
}
else if(strEQ(key, "filename")) {
filename = ap_getword_conf(r->pool, &pair);
}
}
}
if (!filename) {
char *value = multipart_buffer_read_body(mbuff);
ap_table_add(req->parms, param, value);
continue;
}
if (!param) continue; /* shouldn't happen, but just in case. */
if (req->disable_uploads) {
ap_log_rerror(REQ_ERROR, "[libapreq] file upload forbidden");
return HTTP_FORBIDDEN;
}
ap_table_add(req->parms, param, filename);
if (upload) {
upload->next = ApacheUpload_new(req);
upload = upload->next;
}
else {
upload = ApacheUpload_new(req);
req->upload = upload;
}
if (! req->upload_hook && ! ApacheRequest_tmpfile(req, upload) ) {
return HTTP_INTERNAL_SERVER_ERROR;
}
upload->info = header;
upload->filename = ap_pstrdup(req->r->pool, filename);
upload->name = ap_pstrdup(req->r->pool, param);
/* mozilla empty-file (missing CRLF) hack */
fill_buffer(mbuff);
if( strEQN(mbuff->buf_begin, mbuff->boundary,
strlen(mbuff->boundary)) ) {
r->remaining -= 2;
continue;
}
while ((blen = multipart_buffer_read(mbuff, buff, sizeof(buff)))) {
if (req->upload_hook != NULL) {
wlen = req->upload_hook(req->hook_data, buff, blen, upload);
} else {
wlen = fwrite(buff, 1, blen, upload->fp);
}
if (wlen != blen) {
return HTTP_INTERNAL_SERVER_ERROR;
}
upload->size += wlen;
}
if (upload->size > 0 && (upload->fp != NULL)) {
fseek(upload->fp, 0, 0);
}
}
}
return OK;
}
STATIC SV *
S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level)
{
AV* av;
GV* gv;
GV** gvp;
HV* hv = Nullhv;
SV* subgen = Nullsv;
if (!stash)
return &PL_sv_undef;
if (strEQ(HvNAME(stash), name))
return &PL_sv_yes;
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
HvNAME(stash));
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
&& (hv = GvHV(gv)))
{
if (SvIV(subgen) == PL_sub_generation) {
SV* sv;
SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
name, HvNAME(stash)) );
return sv;
}
}
else {
DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
HvNAME(stash)) );
hv_clear(hv);
sv_setiv(subgen, PL_sub_generation);
}
}
gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
if (!hv || !subgen) {
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
gv = *gvp;
if (SvTYPE(gv) != SVt_PVGV)
gv_init(gv, stash, "::ISA::CACHE::", 14, TRUE);
if (!hv)
hv = GvHVn(gv);
if (!subgen) {
subgen = newSViv(PL_sub_generation);
GvSV(gv) = subgen;
}
}
if (hv) {
SV** svp = AvARRAY(av);
/* NOTE: No support for tied ISA */
I32 items = AvFILLp(av) + 1;
while (items--) {
SV* sv = *svp++;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ WARN_SYNTAX,
"Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
}
if (&PL_sv_yes == isa_lookup(basestash, name, len, level + 1)) {
(void)hv_store(hv,name,len,&PL_sv_yes,0);
return &PL_sv_yes;
}
}
(void)hv_store(hv,name,len,&PL_sv_no,0);
}
}
return boolSV(strEQ(name, "UNIVERSAL"));
}
