/*
* $dbmctl(OPEN type filename)
* Open a DBM file for read and write access.
* $dbmctl(OPEN_READ type filename)
* Open a DBM file for read-only access.
* $dbmctl(CLOSE refnum)
* Close a previously opened DBM file
* $dbmctl(ADD refnum "key" data)
* Insert a new key/data pair. Fail if key already exists.
* $dbmctl(CHANGE refnum "key" data)
* If key already exists, change its data. If it doesn't exist, add it.
* $dbmctl(DELETE refnum "key")
* Remove a key/data pair
* $dbmctl(READ refnum "key")
* Return the data for a key.
* $dbmctl(NEXT_KEY refnum start-over)
* Return the next key in the database
* $dbmctl(ALL_KEYS refnum)
* Return all keys -- could be huge! could take a long time!
* $dbmctl(ERROR refnum)
* Return the errno for the last error.
*
* "refnum" is a value returned by OPEN and OPEN_READ.
* "type" must always be "STD" for now.
* "filename" is a dbm file (without the .db extension!)
* "key" is a dbm key. Spaces are important!
* "data" is a dbm value. Spaces are important!
*
*/
char * dbmctl (char *input)
{
char * listc;
int refnum;
char * type;
char * key;
int retval;
char * retstr;
GET_FUNC_ARG(listc, input);
if (!my_strnicmp(listc, "OPEN", 4)) {
GET_FUNC_ARG(type, input); /* Ignored for now */
retval = open_dbm(input, 0, 0);
RETURN_INT(retval);
} else if (!my_strnicmp(listc, "OPEN_READ", 5)) {
GET_FUNC_ARG(type, input); /* Ignored for now */
retval = open_dbm(input, 1, 0);
RETURN_INT(retval);
} else if (!my_strnicmp(listc, "CLOSE", 2)) {
GET_INT_ARG(refnum, input);
retval = close_dbm(refnum);
RETURN_INT(retval);
} else if (!my_strnicmp(listc, "ADD", 2)) {
GET_INT_ARG(refnum, input);
GET_DWORD_ARG(key, input);
retval = write_to_dbm(refnum, key, input, 0);
RETURN_INT(retval);
} else if (!my_strnicmp(listc, "CHANGE", 2)) {
GET_INT_ARG(refnum, input);
GET_DWORD_ARG(key, input);
retval = write_to_dbm(refnum, key, input, 1);
RETURN_INT(retval);
} else if (!my_strnicmp(listc, "DELETE", 1)) {
GET_INT_ARG(refnum, input);
GET_DWORD_ARG(key, input);
retval = delete_from_dbm(refnum, key);
RETURN_INT(retval);
} else if (!my_strnicmp(listc, "READ", 1)) {
GET_INT_ARG(refnum, input);
GET_DWORD_ARG(key, input);
retstr = read_from_dbm(refnum, key);
RETURN_MSTR(retstr);
} else if (!my_strnicmp(listc, "NEXT_KEY", 1)) {
int restart;
GET_INT_ARG(refnum, input);
GET_INT_ARG(restart, input);
retstr = iterate_on_dbm(refnum, restart);
RETURN_MSTR(retstr);
} else if (!my_strnicmp(listc, "ALL_KEYS", 2)) {
GET_INT_ARG(refnum, input);
retstr = all_keys_for_dbm(refnum);
RETURN_MSTR(retstr);
} else if (!my_strnicmp(listc, "ERROR", 1)) {
GET_INT_ARG(refnum, input);
retval = error_from_dbm(refnum);
RETURN_INT(retval);
}
RETURN_EMPTY;
}
char * perlcall (char* sub, char* in, char* out, long item, char* input)
{
char *retval=NULL;
int count, foo;
an_array *array;
dSP ;
if (!isperlrunning)
RETURN_MSTR(retval);
++perlcalldepth;
ENTER;
SAVETMPS;
PUSHMARK(SP);
if (input && *input)
XPUSHs(sv_2mortal(newSVpv(input, 0)));
if (in && *in && (array=get_array(in))) {
for (foo=0; foo<array->size; foo++) {
XPUSHs(sv_2mortal(newSVpv(array->item[foo], 0)));
}
}
PUTBACK ;
if (out && *out) {
long size;
upper(out);
size=(array=get_array(out))?array->size:0;
if (0>item)
item=size-~item;
if (item>size)
item=-1;
} else {
item=-1;
}
if (0<=item) {
I32 ax;
count = perl_call_pv(sub, G_EVAL|G_ARRAY);
SPAGAIN ;
SP -= count ;
ax = (SP - PL_stack_base) + 1 ;
for (foo=0; foo<count; foo++) {
set_item(out, item+foo, (char*)SvPV_nolen(ST(foo)), 1);
}
retval=(void*)new_realloc((void**)(&retval),32);
snprintf(retval,31,"%u",count);
} else {
SV *sv;
count = perl_call_pv(sub, G_EVAL|G_SCALAR);
SPAGAIN ; sv=POPs ;
SV2STR(sv,retval);
}
PUTBACK ;
FREETMPS; LEAVE;
--perlcalldepth;
RETURN_MSTR(retval);
}
char* perleval (char* input) {
char *retval=NULL;
if (input && *input) {
SV *sv;
perlstartstop(1);
++perlcalldepth;
ENTER; SAVETMPS;
sv=perl_eval_pv((char*)input, FALSE);
SV2STR(sv,retval);
FREETMPS; LEAVE;
--perlcalldepth;
};
RETURN_MSTR(retval);
}
/*
* $levelctl(LEVELS)
* $levelctl(ADD name)
* $levelctl(ALIAS old-name new-name)
* $levelctl(LOOKUP name-or-number)
* $levelctl(NORMALIZE string)
*/
char *levelctl (char *input)
{
char *listc, *retval;
const char *newlevel, *oldlevel;
int oldnum, newnum;
GET_FUNC_ARG(listc, input);
if (!my_strnicmp(listc, "LEVELS", 2)) {
retval = get_all_levels();
RETURN_MSTR(retval);
} else if (!my_strnicmp(listc, "ADD", 2)) {
GET_FUNC_ARG(newlevel, input);
newnum = add_new_level(newlevel);
RETURN_INT(newnum);
} else if (!my_strnicmp(listc, "ALIAS", 2)) {
GET_FUNC_ARG(oldlevel, input);
GET_FUNC_ARG(newlevel, input);
oldnum = str_to_level(oldlevel);
newnum = add_new_level_alias(oldnum, newlevel);
RETURN_INT(newnum);
} else if (!my_strnicmp(listc, "LOOKUP", 2)) {
GET_FUNC_ARG(newlevel, input);
if (is_number(newlevel)) {
oldnum = STR2INT(newlevel);
oldlevel = level_to_str(oldnum);
RETURN_STR(oldlevel);
} else {
oldnum = str_to_level(newlevel);
RETURN_INT(oldnum);
}
} else if (!my_strnicmp(listc, "NORMALIZE", 1)) {
Mask m;
const char *r;
char *err = NULL;
mask_unsetall(&m);
str_to_mask(&m, input, &err); /* Errors are ignored */
r = mask_to_str(&m);
RETURN_STR(r);
}
RETURN_EMPTY;
}
/*
* $logctl(NEW)
* $logctl(REFNUMS [ACTIVE|INACTIVE|ALL])
* $logctl(REFNUM log-desc)
* $logctl(ADD log-desc [target])
* $logctl(DELETE log-desc [target])
* $logctl(GET <refnum> [LIST])
* $logctl(SET <refnum> [ITEM] [VALUE])
* $logctl(MATCH [pattern])
* $logctl(PMATCH [pattern])
*
* [LIST] and [ITEM] are one of the following
* REFNUM The refnum for the log (GET only)
* NAME The logical name for the log
* FILENAME The filename this log writes to
* SERVER The server this log associates with (-1 for any)
* TARGETS All of the targets for this log
* LEVEL The Lastlog Level for this log
* REWRITE The rewrite rule for this log
* MANGLE The mangle rule for this log
* STATUS 1 if log is on, 0 if log is off.
* TYPE Either "TARGET", "WINDOW", or "SERVER"
*/
char *logctl (char *input)
{
char *refstr;
char *listc;
int val;
Logfile *log;
GET_FUNC_ARG(listc, input);
if (!my_strnicmp(listc, "NEW", 3)) {
log = new_logfile();
RETURN_INT(log->refnum);
} else if (!my_strnicmp(listc, "LAST_CREATED", 12)) {
RETURN_INT(last_logref);
} else if (!my_strnicmp(listc, "REFNUMS", 7)) {
char * retval = NULL;
int active;
GET_FUNC_ARG(refstr, input);
if (!my_stricmp(refstr, "ACTIVE"))
active = 1;
else if (!my_stricmp(refstr, "INACTIVE"))
active = 0;
else if (!my_stricmp(refstr, "ALL"))
active = -1;
else
RETURN_EMPTY;
for (log = logfiles; log; log = log->next)
{
if (active != -1 && active != log->active)
continue;
malloc_strcat_word(&retval, space, ltoa(log->refnum), DWORD_NO);
}
RETURN_MSTR(retval);
} else if (!my_strnicmp(listc, "REFNUM", 6)) {
GET_FUNC_ARG(refstr, input);
if (!(log = get_log_by_desc(refstr)))
RETURN_EMPTY;
RETURN_INT(log->refnum);
} else if (!my_strnicmp(listc, "ADD", 2)) {
GET_FUNC_ARG(refstr, input);
if (!(log = get_log_by_desc(refstr)))
RETURN_EMPTY;
logfile_add(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "DELETE", 2)) {
GET_FUNC_ARG(refstr, input);
if (!(log = get_log_by_desc(refstr)))
RETURN_EMPTY;
logfile_remove(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "GET", 2)) {
GET_FUNC_ARG(refstr, input);
if (!(log = get_log_by_desc(refstr)))
RETURN_EMPTY;
GET_FUNC_ARG(listc, input);
if (!my_strnicmp(listc, "REFNUM", 3)) {
RETURN_INT(log->refnum);
} else if (!my_strnicmp(listc, "NAME", 3)) {
RETURN_STR(log->name);
} else if (!my_strnicmp(listc, "FILENAME", 3)) {
RETURN_STR(log->filename);
} else if (!my_strnicmp(listc, "SERVER", 3)) {
RETURN_INT(log->servref);
} else if (!my_strnicmp(listc, "TARGETS", 3)) {
char *ret = logfile_get_targets(log);
RETURN_MSTR(ret);
} else if (!my_strnicmp(listc, "LEVEL", 3)) {
const char *ret = mask_to_str(&log->mask);
RETURN_STR(ret);
} else if (!my_strnicmp(listc, "REWRITE", 3)) {
RETURN_STR(log->rewrite);
} else if (!my_strnicmp(listc, "MANGLE", 3)) {
RETURN_STR(log->mangle_desc);
} else if (!my_strnicmp(listc, "STATUS", 3)) {
RETURN_INT(log->active);
} else if (!my_strnicmp(listc, "TYPE", 3)) {
RETURN_STR(logtype[log->type]);
} else if (!my_strnicmp(listc, "ACTIVITY", 1)) {
RETURN_INT(log->activity);
}
} else if (!my_strnicmp(listc, "SET", 1)) {
GET_FUNC_ARG(refstr, input);
if (!(log = get_log_by_desc(refstr)))
RETURN_EMPTY;
GET_FUNC_ARG(listc, input);
if (!my_strnicmp(listc, "NAME", 3)) {
logfile_name(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "FILENAME", 3)) {
logfile_filename(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "SERVER", 3)) {
logfile_server(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "TARGETS", 3)) {
clean_log_targets(log);
logfile_add(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "LEVEL", 3)) {
logfile_level(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "REWRITE", 3)) {
logfile_rewrite(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "MANGLE", 3)) {
logfile_mangle(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "STATUS", 3)) {
GET_INT_ARG(val, input);
if (val)
logfile_on(log, &input);
else
logfile_off(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "TYPE", 3)) {
logfile_type(log, &input);
RETURN_INT(1);
} else if (!my_strnicmp(listc, "ACTIVITY", 1)) {
logfile_activity(log, &input);
RETURN_INT(1);
}
} else if (!my_strnicmp(listc, "MATCH", 1)) {
RETURN_EMPTY; /* Not implemented for now. */
} else if (!my_strnicmp(listc, "PMATCH", 1)) {
RETURN_EMPTY; /* Not implemented for now. */
} else if (!my_strnicmp(listc, "CURRENT", 1)) {
RETURN_INT(current_log_refnum);
} else
RETURN_EMPTY;
RETURN_EMPTY;
}
/*
* $timerctl(REFNUM refnum)
* $timerctl(ADD <refnum> <interval> <events> <commands> <subargs> <window>)
* $timerctl(DELETE <refnum>)
* $timerctl(GET <refnum> [LIST])
* $timerctl(SET <refnum> [ITEM] [VALUE])
* $timerctl(REFNUMS)
*
* [LIST] and [ITEM] are one of the following
* TIMEOUT The precise time the timer will be executed
* COMMAND The commands that will be executed
* SUBARGS The vaule of $* used when this timer is executed
* REPEATS The number of times this timer will be executed
* INTERVAL The interval of time between executions
* SERVER The server this timer bound to
* WINDOW The window this timer bound to
*/
char * timerctl (char *input)
{
char * refstr;
char * listc;
Timer * t;
int len;
GET_FUNC_ARG(listc, input);
len = strlen(listc);
if (!my_strnicmp(listc, "REFNUM", len)) {
GET_FUNC_ARG(refstr, input);
if (!(t = get_timer(refstr)))
RETURN_EMPTY;
RETURN_STR(t->ref);
} else if (!my_strnicmp(listc, "REFNUMS", len)) {
char * retval = NULL;
size_t clue = 0;
for (t = PendingTimers; t; t = t->next)
malloc_strcat_word_c(&retval, space, t->ref, DWORD_DWORDS, &clue);
RETURN_MSTR(retval);
} else if (!my_strnicmp(listc, "ADD", len)) {
RETURN_EMPTY; /* XXX - Not implemented yet. */
} else if (!my_strnicmp(listc, "DELETE", len)) {
GET_FUNC_ARG(refstr, input);
if (!(t = get_timer(refstr)))
RETURN_EMPTY;
if (t->callback)
RETURN_EMPTY;
RETURN_INT(remove_timer(refstr));
} else if (!my_strnicmp(listc, "GET", len)) {
GET_FUNC_ARG(refstr, input);
if (!(t = get_timer(refstr)))
RETURN_EMPTY;
GET_FUNC_ARG(listc, input);
len = strlen(listc);
if (!my_strnicmp(listc, "TIMEOUT", len)) {
return malloc_sprintf(NULL, "%ld %ld", (long) t->time.tv_sec,
(long) t->time.tv_usec);
} else if (!my_strnicmp(listc, "COMMAND", len)) {
if (t->callback)
RETURN_EMPTY;
RETURN_STR(t->command);
} else if (!my_strnicmp(listc, "SUBARGS", len)) {
if (t->callback)
RETURN_EMPTY;
RETURN_STR(t->subargs);
} else if (!my_strnicmp(listc, "REPEATS", len)) {
RETURN_INT(t->events);
} else if (!my_strnicmp(listc, "INTERVAL", len)) {
return malloc_sprintf(NULL, "%ld %ld", (long) t->interval.tv_sec,
(long) t->interval.tv_usec);
} else if (!my_strnicmp(listc, "SERVER", len)) {
if (t->domain != SERVER_TIMER)
RETURN_INT(-1);
RETURN_INT(t->domref);
} else if (!my_strnicmp(listc, "WINDOW", len)) {
if (t->domain != WINDOW_TIMER)
RETURN_INT(-1);
RETURN_INT(t->domref);
}
} else if (!my_strnicmp(listc, "SET", len)) {
GET_FUNC_ARG(refstr, input);
if (!(t = get_timer(refstr)))
RETURN_EMPTY;
/* Changing internal system timers is strictly prohibited */
if (t->callback)
RETURN_EMPTY;
GET_FUNC_ARG(listc, input);
len = strlen(listc);
if (!my_strnicmp(listc, "TIMEOUT", len)) {
time_t tv_sec;
long tv_usec;
GET_INT_ARG(tv_sec, input);
GET_INT_ARG(tv_usec, input);
t->time.tv_sec = tv_sec;
t->time.tv_usec = tv_usec;
} else if (!my_strnicmp(listc, "COMMAND", len)) {
malloc_strcpy((char **)&t->command, input);
} else if (!my_strnicmp(listc, "SUBARGS", len)) {
malloc_strcpy(&t->subargs, input);
} else if (!my_strnicmp(listc, "REPEATS", len)) {
long repeats;
GET_INT_ARG(repeats, input);
t->events = repeats;
} else if (!my_strnicmp(listc, "INTERVAL", len)) {
time_t tv_sec;
long tv_usec;
GET_INT_ARG(tv_sec, input);
GET_INT_ARG(tv_usec, input);
t->interval.tv_sec = tv_sec;
t->interval.tv_usec = tv_usec;
} else if (!my_strnicmp(listc, "SERVER", len)) {
int refnum;
GET_INT_ARG(refnum, input);
t->domain = SERVER_TIMER;
t->domref = refnum;
} else if (!my_strnicmp(listc, "WINDOW", len)) {
int refnum;
GET_INT_ARG(refnum, input);
t->domain = WINDOW_TIMER;
t->domref = refnum;
}
} else
RETURN_EMPTY;
RETURN_EMPTY;
}