source: perlconfig.c @ 3e36085

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 3e36085 was a556caa, checked in by Nelson Elhage <nelhage@mit.edu>, 15 years ago
Mostly refactor the editwin to use a linear buffer position. Use a linear buffer positino to keep track of the point, rather than (x, y). In addition, make the editwin structure private to editwin.c. (No abstraction violation for you!) Add some abstractions for pointer movement, and use them in some places.
  • Property mode set to 100644
File size: 13.4 KB
Line 
1#include <stdio.h>
2#include <stdlib.h>
3#include <string.h>
4#include <sys/types.h>
5#include <sys/stat.h>
6#include <errno.h>
7#define OWL_PERL
8#include "owl.h"
9
10static const char fileIdent[] = "$Id$";
11
12extern XS(boot_BarnOwl);
13extern XS(boot_DynaLoader);
14/* extern XS(boot_DBI); */
15
16static void owl_perl_xs_init(pTHX)
17{
18  char *file = __FILE__;
19  dXSUB_SYS;
20  {
21    newXS("BarnOwl::bootstrap", boot_BarnOwl, file);
22    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
23  }
24}
25
26SV *owl_perlconfig_message2hashref(owl_message *m)
27{
28  HV *h, *stash;
29  SV *hr;
30  char *ptr, *blessas, *type;
31  int i, j;
32  owl_pair *pair;
33  owl_filter *wrap;
34
35  if (!m) return &PL_sv_undef;
36  wrap = owl_global_get_filter(&g, "wordwrap");
37  if(!wrap) {
38      owl_function_error("wrap filter is not defined");
39      return &PL_sv_undef;
40  }
41
42  h = newHV();
43
44#define MSG2H(h,field) (void)hv_store(h, #field, strlen(#field),        \
45                                      newSVpv(owl_message_get_##field(m),0), 0)
46
47  if (owl_message_is_type_zephyr(m)
48      && owl_message_is_direction_in(m)) {
49    /* Handle zephyr-specific fields... */
50    AV *av_zfields;
51
52    av_zfields = newAV();
53    j=owl_zephyr_get_num_fields(owl_message_get_notice(m));
54    for (i=0; i<j; i++) {
55      ptr=owl_zephyr_get_field_as_utf8(owl_message_get_notice(m), i+1);
56      av_push(av_zfields, newSVpvn(ptr, strlen(ptr)));
57      owl_free(ptr);
58    }
59    (void)hv_store(h, "fields", strlen("fields"), newRV_noinc((SV*)av_zfields), 0);
60
61    (void)hv_store(h, "auth", strlen("auth"), 
62                   newSVpv(owl_zephyr_get_authstr(owl_message_get_notice(m)),0),0);
63  }
64
65  j=owl_list_get_size(&(m->attributes));
66  for(i=0; i<j; i++) {
67    pair=owl_list_get_element(&(m->attributes), i);
68    (void)hv_store(h, owl_pair_get_key(pair), strlen(owl_pair_get_key(pair)),
69                   newSVpv(owl_pair_get_value(pair),0),0);
70  }
71 
72  MSG2H(h, type);
73  MSG2H(h, direction);
74  MSG2H(h, class);
75  MSG2H(h, instance);
76  MSG2H(h, sender);
77  MSG2H(h, realm);
78  MSG2H(h, recipient);
79  MSG2H(h, opcode);
80  MSG2H(h, hostname);
81  MSG2H(h, body);
82  MSG2H(h, login);
83  MSG2H(h, zsig);
84  MSG2H(h, zwriteline);
85  if (owl_message_get_header(m)) {
86    MSG2H(h, header); 
87  }
88  (void)hv_store(h, "time", strlen("time"), newSVpv(owl_message_get_timestr(m),0),0);
89  (void)hv_store(h, "unix_time", strlen("unix_time"), newSViv(m->time), 0);
90  (void)hv_store(h, "id", strlen("id"), newSViv(owl_message_get_id(m)),0);
91  (void)hv_store(h, "deleted", strlen("deleted"), newSViv(owl_message_is_delete(m)),0);
92  (void)hv_store(h, "private", strlen("private"), newSViv(owl_message_is_private(m)),0);
93  (void)hv_store(h, "should_wordwrap",
94                 strlen("should_wordwrap"), newSViv(
95                                                    owl_filter_message_match(wrap, m)),0);
96
97  type = owl_message_get_type(m);
98  if(!type || !*type) type = "generic";
99  type = owl_strdup(type);
100  type[0] = toupper(type[0]);
101  blessas = owl_sprintf("BarnOwl::Message::%s", type);
102
103  hr = newRV_noinc((SV*)h);
104  stash =  gv_stashpv(blessas,0);
105  if(!stash) {
106    owl_function_error("No such class: %s for message type %s", blessas, owl_message_get_type(m));
107    stash = gv_stashpv("BarnOwl::Message", 1);
108  }
109  hr = sv_bless(hr,stash);
110  owl_free(type);
111  owl_free(blessas);
112  return hr;
113}
114
115SV *owl_perlconfig_curmessage2hashref(void) /*noproto*/
116{
117  int curmsg;
118  owl_view *v;
119  v=owl_global_get_current_view(&g);
120  if (owl_view_get_size(v) < 1) {
121    return &PL_sv_undef;
122  }
123  curmsg=owl_global_get_curmsg(&g);
124  return owl_perlconfig_message2hashref(owl_view_get_element(v, curmsg));
125}
126
127/* XXX TODO: Messages should round-trip properly between
128   message2hashref and hashref2message. Currently we lose
129   zephyr-specific properties stored in the ZNotice_t
130
131   This has been somewhat addressed, but is still not lossless.
132 */
133owl_message * owl_perlconfig_hashref2message(SV *msg)
134{
135  owl_message * m;
136  HE * ent;
137  I32 count, len;
138  char *key,*val;
139  HV * hash;
140  struct tm tm;
141
142  hash = (HV*)SvRV(msg);
143
144  m = owl_malloc(sizeof(owl_message));
145  owl_message_init(m);
146
147  count = hv_iterinit(hash);
148  while((ent = hv_iternext(hash))) {
149    key = hv_iterkey(ent, &len);
150    val = SvPV_nolen(hv_iterval(hash, ent));
151    if(!strcmp(key, "type")) {
152      owl_message_set_type(m, val);
153    } else if(!strcmp(key, "direction")) {
154      owl_message_set_direction(m, owl_message_parse_direction(val));
155    } else if(!strcmp(key, "private")) {
156      SV * v = hv_iterval(hash, ent);
157      if(SvTRUE(v)) {
158        owl_message_set_isprivate(m);
159      }
160    } else if (!strcmp(key, "hostname")) {
161      owl_message_set_hostname(m, val);
162    } else if (!strcmp(key, "zwriteline")) {
163      owl_message_set_zwriteline(m, val);
164    } else if (!strcmp(key, "time")) {
165      m->timestr = owl_strdup(val);
166      strptime(val, "%a %b %d %T %Y", &tm);
167      m->time = mktime(&tm);
168    } else {
169      owl_message_set_attribute(m, key, val);
170    }
171  }
172  if(owl_message_is_type_admin(m)) {
173    if(!owl_message_get_attribute_value(m, "adminheader"))
174      owl_message_set_attribute(m, "adminheader", "");
175  }
176#ifdef HAVE_LIBZEPHYR
177  if (owl_message_is_type_zephyr(m)) {
178    ZNotice_t *n = &(m->notice);
179    n->z_kind = ACKED;
180    n->z_port = 0;
181    n->z_auth = ZAUTH_NO;
182    n->z_checked_auth = 0;
183    n->z_class = owl_message_get_class(m);
184    n->z_class_inst = owl_message_get_instance(m);
185    n->z_opcode = owl_message_get_opcode(m);
186    n->z_sender = owl_message_get_sender(m);
187    n->z_recipient = owl_message_get_recipient(m);
188    n->z_default_format = "[zephyr created from perl]";
189    n->z_multinotice = "[zephyr created from perl]";
190    n->z_num_other_fields = 0;
191    n->z_message = owl_sprintf("%s%c%s", owl_message_get_zsig(m), '\0', owl_message_get_body(m));
192    n->z_message_len = strlen(owl_message_get_zsig(m)) + strlen(owl_message_get_body(m)) + 1;
193  }
194#endif
195  return m;
196}
197
198/* Calls in a scalar context, passing it a hash reference.
199   If return value is non-null, caller must free. */
200char *owl_perlconfig_call_with_message(char *subname, owl_message *m)
201{
202  dSP ;
203  int count;
204  SV *msgref, *srv;
205  char *out;
206 
207  ENTER ;
208  SAVETMPS;
209 
210  PUSHMARK(SP) ;
211  msgref = owl_perlconfig_message2hashref(m);
212  XPUSHs(sv_2mortal(msgref));
213  PUTBACK ;
214 
215  count = call_pv(subname, G_SCALAR|G_EVAL|G_KEEPERR);
216 
217  SPAGAIN ;
218
219  if (SvTRUE(ERRSV)) {
220    owl_function_error("Perl Error: '%s'", SvPV_nolen(ERRSV));
221    /* and clear the error */
222    sv_setsv (ERRSV, &PL_sv_undef);
223  }
224
225  if (count != 1) {
226    fprintf(stderr, "bad perl!  no biscuit!  returned wrong count!\n");
227    abort();
228  }
229
230  srv = POPs;
231
232  if (srv) {
233    out = owl_strdup(SvPV_nolen(srv));
234  } else {
235    out = NULL;
236  }
237 
238  PUTBACK ;
239  FREETMPS ;
240  LEAVE ;
241
242  return out;
243}
244
245
246/* Calls a method on a perl object representing a message.
247   If the return value is non-null, the caller must free it.
248 */
249char * owl_perlconfig_message_call_method(owl_message *m, char *method, int argc, char ** argv)
250{
251  dSP;
252  unsigned int count, i;
253  SV *msgref, *srv;
254  char *out;
255
256  msgref = owl_perlconfig_message2hashref(m);
257
258  ENTER;
259  SAVETMPS;
260
261  PUSHMARK(SP);
262  XPUSHs(sv_2mortal(msgref));
263  for(i=0;i<argc;i++) {
264    XPUSHs(sv_2mortal(newSVpv(argv[i], 0)));
265  }
266  PUTBACK;
267
268  count = call_method(method, G_SCALAR|G_KEEPERR|G_EVAL);
269
270  SPAGAIN;
271
272  if(count != 1) {
273    fprintf(stderr, "perl returned wrong count %d\n", count);
274    abort();
275  }
276
277  if (SvTRUE(ERRSV)) {
278    owl_function_error("Error: '%s'", SvPV_nolen(ERRSV));
279    /* and clear the error */
280    sv_setsv (ERRSV, &PL_sv_undef);
281  }
282
283  srv = POPs;
284
285  if (srv) {
286    out = owl_strdup(SvPV_nolen(srv));
287  } else {
288    out = NULL;
289  }
290
291  PUTBACK;
292  FREETMPS;
293  LEAVE;
294
295  return out;
296}
297
298
299char *owl_perlconfig_initperl(char * file, int *Pargc, char ***Pargv, char *** Penv)
300{
301  int ret;
302  PerlInterpreter *p;
303  char *err;
304  char *args[4] = {"", "-e", "0;", NULL};
305  AV *inc;
306  char *path;
307
308  /* create and initialize interpreter */
309  PERL_SYS_INIT3(Pargc, Pargv, Penv);
310  p=perl_alloc();
311  owl_global_set_perlinterp(&g, (void*)p);
312  perl_construct(p);
313
314  owl_global_set_no_have_config(&g);
315
316  ret=perl_parse(p, owl_perl_xs_init, 2, args, NULL);
317  if (ret || SvTRUE(ERRSV)) {
318    err=owl_strdup(SvPV_nolen(ERRSV));
319    sv_setsv(ERRSV, &PL_sv_undef);     /* and clear the error */
320    return(err);
321  }
322
323  ret=perl_run(p);
324  if (ret || SvTRUE(ERRSV)) {
325    err=owl_strdup(SvPV_nolen(ERRSV));
326    sv_setsv(ERRSV, &PL_sv_undef);     /* and clear the error */
327    return(err);
328  }
329
330  owl_global_set_have_config(&g);
331
332  /* create legacy variables */
333  get_sv("BarnOwl::id", TRUE);
334  get_sv("BarnOwl::class", TRUE);
335  get_sv("BarnOwl::instance", TRUE);
336  get_sv("BarnOwl::recipient", TRUE);
337  get_sv("BarnOwl::sender", TRUE);
338  get_sv("BarnOwl::realm", TRUE);
339  get_sv("BarnOwl::opcode", TRUE);
340  get_sv("BarnOwl::zsig", TRUE);
341  get_sv("BarnOwl::msg", TRUE);
342  get_sv("BarnOwl::time", TRUE);
343  get_sv("BarnOwl::host", TRUE);
344  get_av("BarnOwl::fields", TRUE);
345
346  if(file) {
347    SV * cfg = get_sv("BarnOwl::configfile", TRUE);
348    sv_setpv(cfg, file);
349  }
350
351  /* Add the system lib path to @INC */
352  inc = get_av("INC", 0);
353  path = owl_sprintf("%s/lib", owl_get_datadir());
354  av_unshift(inc, 1);
355  av_store(inc, 0, newSVpv(path, 0));
356  owl_free(path);
357
358  eval_pv("use BarnOwl;", FALSE);
359
360  if (SvTRUE(ERRSV)) {
361    err=owl_strdup(SvPV_nolen(ERRSV));
362    sv_setsv (ERRSV, &PL_sv_undef);     /* and clear the error */
363    return(err);
364  }
365
366  /* check if we have the formatting function */
367  if (owl_perlconfig_is_function("BarnOwl::format_msg")) {
368    owl_global_set_config_format(&g, 1);
369  }
370
371  return(NULL);
372}
373
374/* returns whether or not a function exists */
375int owl_perlconfig_is_function(char *fn) {
376  if (get_cv(fn, FALSE)) return(1);
377  else return(0);
378}
379
380/* caller is responsible for freeing returned string */
381char *owl_perlconfig_execute(char *line)
382{
383  STRLEN len;
384  SV *response;
385  char *out, *preout;
386
387  if (!owl_global_have_config(&g)) return NULL;
388
389  ENTER;
390  SAVETMPS;
391  /* execute the subroutine */
392  response = eval_pv(line, FALSE);
393
394  if (SvTRUE(ERRSV)) {
395    owl_function_error("Perl Error: '%s'", SvPV_nolen(ERRSV));
396    sv_setsv (ERRSV, &PL_sv_undef);     /* and clear the error */
397  }
398
399  preout=SvPV(response, len);
400  if (len == 0 || preout[len - 1] != '\n')
401    out = owl_sprintf("%s\n", preout);
402  else
403    out = owl_strdup(preout);
404  FREETMPS;
405  LEAVE;
406
407  return(out);
408}
409
410void owl_perlconfig_getmsg(owl_message *m, char *subname)
411{
412  char *ptr = NULL;
413  if (owl_perlconfig_is_function("BarnOwl::Hooks::_receive_msg")) {
414    ptr = owl_perlconfig_call_with_message(subname?subname
415                                           :"BarnOwl::_receive_msg_legacy_wrap", m);
416  }
417  if (ptr) owl_free(ptr);
418}
419
420/* Called on all new messages; receivemsg is only called on incoming ones */
421void owl_perlconfig_newmsg(owl_message *m, char *subname)
422{
423  char *ptr = NULL;
424  if (owl_perlconfig_is_function("BarnOwl::Hooks::_new_msg")) {
425    ptr = owl_perlconfig_call_with_message(subname?subname
426                                           :"BarnOwl::Hooks::_new_msg", m);
427  }
428  if (ptr) owl_free(ptr);
429}
430
431char *owl_perlconfig_perlcmd(owl_cmd *cmd, int argc, char **argv)
432{
433  int i, count;
434  char * ret = NULL;
435  SV *rv;
436  dSP;
437
438  ENTER;
439  SAVETMPS;
440
441  PUSHMARK(SP);
442  for(i=0;i<argc;i++) {
443    SV *tmp = newSVpv(argv[i], 0);
444    SvUTF8_on(tmp);
445    XPUSHs(sv_2mortal(tmp));
446  }
447  PUTBACK;
448
449  count = call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL);
450
451  SPAGAIN;
452
453  if(SvTRUE(ERRSV)) {
454    owl_function_error("%s", SvPV_nolen(ERRSV));
455    (void)POPs;
456  } else {
457    if(count != 1)
458      croak("Perl command %s returned more than one value!", cmd->name);
459    rv = POPs;
460    if(SvTRUE(rv)) {
461      ret = owl_strdup(SvPV_nolen(rv));
462    }
463  }
464
465  FREETMPS;
466  LEAVE;
467
468  return ret;
469}
470
471void owl_perlconfig_cmd_free(owl_cmd *cmd)
472{
473  SvREFCNT_dec(cmd->cmd_perl);
474}
475
476void owl_perlconfig_dispatch_free(owl_dispatch *d)
477{
478  SvREFCNT_dec((SV*)d->data);
479  owl_free(d);
480}
481
482void owl_perlconfig_edit_callback(owl_editwin *e)
483{
484  SV *cb = (SV*)owl_editwin_get_cbdata(e);
485  SV *text;
486  dSP;
487
488  if(cb == NULL) {
489    owl_function_error("Perl callback is NULL!");
490  }
491  text = newSVpv(owl_editwin_get_text(e), 0);
492  SvUTF8_on(text);
493
494  ENTER;
495  SAVETMPS;
496
497  PUSHMARK(SP);
498  XPUSHs(sv_2mortal(text));
499  PUTBACK;
500 
501  call_sv(cb, G_DISCARD|G_KEEPERR|G_EVAL);
502
503  if(SvTRUE(ERRSV)) {
504    owl_function_error("%s", SvPV_nolen(ERRSV));
505  }
506
507  FREETMPS;
508  LEAVE;
509
510  SvREFCNT_dec(cb);
511  owl_editwin_set_cbdata(e, NULL);
512}
513
514void owl_perlconfig_mainloop()
515{
516  dSP;
517  if (!owl_perlconfig_is_function("BarnOwl::Hooks::_mainloop_hook"))
518    return;
519  PUSHMARK(SP) ;
520  call_pv("BarnOwl::Hooks::_mainloop_hook", G_DISCARD|G_EVAL);
521  if(SvTRUE(ERRSV)) {
522    owl_function_error("%s", SvPV_nolen(ERRSV));
523  }
524  return;
525}
526
527void owl_perlconfig_dispatch(owl_dispatch *d)
528{
529  SV *cb = d->data;
530  dSP;
531  if(cb == NULL) {
532    owl_function_error("Perl callback is NULL!");
533    return;
534  }
535
536  ENTER;
537  SAVETMPS;
538
539  PUSHMARK(SP);
540  PUTBACK;
541 
542  call_sv(cb, G_DISCARD|G_KEEPERR|G_EVAL);
543
544  if(SvTRUE(ERRSV)) {
545    owl_function_error("%s", SvPV_nolen(ERRSV));
546  }
547
548  FREETMPS;
549  LEAVE;
550}
551
552void owl_perlconfig_perl_timer(owl_timer *t, void *data)
553{
554  SV *obj = data;
555
556  if(!SvROK(obj)) {
557    return;
558  }
559
560  dSP;
561  ENTER;
562  SAVETMPS;
563
564  PUSHMARK(SP);
565  XPUSHs(obj);
566  PUTBACK;
567
568  call_method("do_callback", G_DISCARD|G_KEEPERR|G_EVAL);
569
570  SPAGAIN;
571
572  if (SvTRUE(ERRSV)) {
573    owl_function_error("Error in calback: '%s'", SvPV_nolen(ERRSV));
574    sv_setsv (ERRSV, &PL_sv_undef);
575  }
576
577  PUTBACK;
578  FREETMPS;
579  LEAVE;
580}
581
582void owl_perlconfig_perl_timer_destroy(owl_timer *t)
583{
584  if(SvOK((SV*)t->data)) {
585    SvREFCNT_dec((SV*)t->data);
586  }
587}
Note: See TracBrowser for help on using the repository browser.