source: perlconfig.c @ f1e629d

barnowl_perlaimdebianowlrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since f1e629d was f1e629d, checked in by Erik Nygren <nygren@mit.edu>, 21 years ago
New API for perl message formatting functions. Legacy variables are still supported for owl::format_msg and owl::receive_msg, but these functions are now also passed an owl::Message object which contains methods for accessing the contents of the message. See perlwrap.pm (and docs TBD) for the available methods. *** WARNING: The exact API for owl::Message has *** not yet stabilized. Added "style" command for creating new styles. Usage: style <name> perl <function_name> Added support for "show styles". Changed global style table from list to dictionary. Changed AIM password prompt from "Password:" to "AIM Password:". Messages are reformatted after a window resize to allow styles to take into account the width of the window. When perl throws an error, the message is put in the msgwin if possible. Added perl functions for: owl::getcurmsg() -- returns an owl::Message object for the active message in the current view. owl::getnumcols() -- returns the column width of the window owl::zephyr_getrealm() -- returns the zephyr realm owl::zephyr_getsender() -- returns the zephyr sender Made owl::COMMAND("foo"); be syntactic sugar for owl::command("COMMAND foo"); *** Is this a good or bad idea? *** This feature may be taken out before release. Added perlwrap.pm to contain perl code to be compiled into the binary. This is transformed into perlwrap.c by encapsulate.pl. Renamed readconfig.c to perlconfig.c and changed variables accordingly. Minor bugfixes in cmd.c and commands.c
  • Property mode set to 100644
File size: 7.1 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#include "owl.h"
8#include <perl.h>
9#include "XSUB.h"
10
11static const char fileIdent[] = "$Id$";
12
13extern char *owl_perlwrap_codebuff;
14
15extern XS(boot_owl);
16
17static void owl_perl_xs_init(pTHX) {
18  char *file = __FILE__;
19  dXSUB_SYS;
20  {
21    newXS("owl::bootstrap", boot_owl, file);
22  }
23}
24
25SV *owl_perlconfig_message2hashref(owl_message *m) { /*noproto*/
26  HV *h;
27  SV *hr;
28  char *ptr, *ptr2, *blessas;
29  int len, i, j;
30
31  if (!m) return &PL_sv_undef;
32  h = newHV();
33
34#define MSG2H(h,field) hv_store(h, #field, strlen(#field), \
35                              newSVpv(owl_message_get_##field(m),0), 0)
36
37  if (owl_message_is_type_zephyr(m)
38      && owl_message_is_direction_in(m)) {
39    /* Handle zephyr-specific fields... */
40    AV *av_zfields;
41
42    av_zfields = newAV();
43    j=owl_zephyr_get_num_fields(owl_message_get_notice(m));
44    for (i=0; i<j; i++) {
45      ptr=owl_zephyr_get_field(owl_message_get_notice(m), i+1, &len);
46      ptr2=owl_malloc(len+1);
47      memcpy(ptr2, ptr, len);
48      ptr2[len]='\0';
49      av_push(av_zfields, newSVpvn(ptr2, len));
50      owl_free(ptr2);
51    }
52    hv_store(h, "fields", strlen("fields"), newRV_noinc((SV*)av_zfields), 0);
53
54    hv_store(h, "auth", strlen("auth"), 
55             newSVpv(owl_zephyr_get_authstr(owl_message_get_notice(m)),0),0);
56  }
57
58  MSG2H(h, type);
59  MSG2H(h, direction);
60  MSG2H(h, class);
61  MSG2H(h, instance);
62  MSG2H(h, sender);
63  MSG2H(h, realm);
64  MSG2H(h, recipient);
65  MSG2H(h, opcode);
66  MSG2H(h, hostname);
67  MSG2H(h, body);
68  MSG2H(h, login);
69  MSG2H(h, zsig);
70  MSG2H(h, zwriteline);
71  if (owl_message_get_header(m)) {
72    MSG2H(h, header); 
73  }
74  hv_store(h, "time", strlen("time"), newSVpv(owl_message_get_timestr(m),0),0);
75  hv_store(h, "id", strlen("id"), newSViv(owl_message_get_id(m)),0);
76  hv_store(h, "deleted", strlen("deleted"), newSViv(owl_message_is_delete(m)),0);
77
78  if (owl_message_is_type_zephyr(m))       blessas = "owl::Message::Zephyr";
79  else if (owl_message_is_type_aim(m))     blessas = "owl::Message::AIM";
80  else if (owl_message_is_type_admin(m))   blessas = "owl::Message::Admin";
81  else if (owl_message_is_type_generic(m)) blessas = "owl::Message::Generic";
82  else                                     blessas = "owl::Message";
83
84  hr = sv_2mortal(newRV_noinc((SV*)h));
85  return sv_bless(hr, gv_stashpv(blessas,0));
86}
87
88
89SV *owl_perlconfig_curmessage2hashref(void) { /*noproto*/
90  int curmsg;
91  owl_view *v;
92  v=owl_global_get_current_view(&g);
93  if (owl_view_get_size(v) < 1) {
94    return &PL_sv_undef;
95  }
96  curmsg=owl_global_get_curmsg(&g);
97  return owl_perlconfig_message2hashref(owl_view_get_element(v, curmsg));
98}
99
100
101/* Calls in a scalar context, passing it a hash reference.
102   If return value is non-null, caller must free. */
103char *owl_perlconfig_call_with_message(char *subname, owl_message *m) {
104  dSP ;
105  int count, len;
106  SV *msgref, *srv;
107  char *out, *preout;
108 
109  ENTER ;
110  SAVETMPS;
111 
112  PUSHMARK(SP) ;
113  msgref = owl_perlconfig_message2hashref(m);
114  XPUSHs(msgref);
115  PUTBACK ;
116 
117  count = call_pv(subname, G_SCALAR|G_EVAL|G_KEEPERR);
118 
119  SPAGAIN ;
120
121  if (SvTRUE(ERRSV)) {
122    STRLEN n_a;
123    owl_function_makemsg("Perl Error: '%s'", SvPV(ERRSV, n_a));
124  }
125
126  if (count != 1) {
127    fprintf(stderr, "bad perl!  no biscuit!  returned wrong count!\n");
128    abort();
129  }
130
131  srv = POPs;
132
133  if (srv) {
134    preout=SvPV(srv, len);
135    out = owl_malloc(strlen(preout)+1);
136    strncpy(out, preout, len);
137    out[len] = '\0';
138  } else {
139    out = NULL;
140  }
141 
142  PUTBACK ;
143  FREETMPS ;
144  LEAVE ;
145
146  return out;
147}
148
149char *owl_perlconfig_readconfig(char *file) {
150  int ret;
151  PerlInterpreter *p;
152  char filename[1024];
153  char *embedding[5];
154  struct stat statbuff;
155
156  if (file==NULL) {
157    sprintf(filename, "%s/%s", getenv("HOME"), ".owlconf");
158  } else {
159    strcpy(filename, file);
160  }
161  embedding[0]="";
162  embedding[1]=filename;
163  embedding[2]=0;
164
165  /* create and initialize interpreter */
166  p=perl_alloc();
167  owl_global_set_perlinterp(&g, (void*)p);
168  perl_construct(p);
169
170  owl_global_set_no_have_config(&g);
171
172  ret=stat(filename, &statbuff);
173  if (ret) {
174    return NULL;
175  }
176
177  ret=perl_parse(p, owl_perl_xs_init, 2, embedding, NULL);
178  if (ret || SvTRUE(ERRSV)) {
179    STRLEN n_a;
180    return owl_strdup(SvPV(ERRSV, n_a));
181  }
182
183  ret=perl_run(p);
184  if (ret || SvTRUE(ERRSV)) {
185    STRLEN n_a;
186    return owl_strdup(SvPV(ERRSV, n_a));
187  }
188
189  owl_global_set_have_config(&g);
190
191  /* create legacy variables */
192  perl_get_sv("owl::id", TRUE);
193  perl_get_sv("owl::class", TRUE);
194  perl_get_sv("owl::instance", TRUE);
195  perl_get_sv("owl::recipient", TRUE);
196  perl_get_sv("owl::sender", TRUE);
197  perl_get_sv("owl::realm", TRUE);
198  perl_get_sv("owl::opcode", TRUE);
199  perl_get_sv("owl::zsig", TRUE);
200  perl_get_sv("owl::msg", TRUE);
201  perl_get_sv("owl::time", TRUE);
202  perl_get_sv("owl::host", TRUE);
203  perl_get_av("owl::fields", TRUE);
204 
205  perl_eval_pv(owl_perlwrap_codebuff, FALSE);
206
207  if (SvTRUE(ERRSV)) {
208    STRLEN n_a;
209    return owl_strdup(SvPV(ERRSV, n_a));
210  }
211
212  /* check if we have the formatting function */
213  if (owl_perlconfig_is_function("owl::format_msg")) {
214    owl_global_set_config_format(&g, 1);
215  }
216
217  return(NULL);
218}
219
220/* returns whether or not a function exists */
221int owl_perlconfig_is_function(char *fn) {
222  if (perl_get_cv(fn, FALSE)) return(1);
223  else return(0);
224}
225
226/* returns 0 on success */
227int owl_perlconfig_get_hashkeys(char *hashname, owl_list *l) {
228  HV *hv;
229  HE *he;
230  char *key;
231  I32 i;
232
233  if (owl_list_create(l)) return(-1);
234  hv = get_hv(hashname, FALSE);
235  if (!hv) return(-1);
236  i = hv_iterinit(hv);
237  while ((he = hv_iternext(hv))) {
238    key = hv_iterkey(he, &i);
239    if (key) {
240      owl_list_append_element(l, owl_strdup(key));
241    }
242  }
243  return(0);
244}
245
246/* caller is responsible for freeing returned string */
247char *owl_perlconfig_execute(char *line) {
248  STRLEN len;
249  SV *response;
250  char *out, *preout;
251
252  if (!owl_global_have_config(&g)) return NULL;
253
254  /* execute the subroutine */
255  response = perl_eval_pv(line, FALSE);
256
257  if (SvTRUE(ERRSV)) {
258    STRLEN n_a;
259    owl_function_makemsg("Perl Error: '%s'", SvPV(ERRSV, n_a));
260  }
261
262  preout=SvPV(response, len);
263  /* leave enough space in case we have to add a newline */
264  out = owl_malloc(strlen(preout)+2);
265  strncpy(out, preout, len);
266  out[len] = '\0';
267  if (!strlen(out) || out[strlen(out)-1]!='\n') {
268    strcat(out, "\n");
269  }
270
271  return(out);
272}
273
274char *owl_perlconfig_getmsg(owl_message *m, int mode, char *subname) { 
275  /* if mode==1 we are doing message formatting.  The returned
276   * formatted message needs to be freed by the caller.
277   *
278   * if mode==0 we are just doing the message-has-been-received
279   * thing.
280   */
281  if (!owl_global_have_config(&g)) return(NULL);
282 
283  /* run the procedure corresponding to the mode */
284  if (mode==1) {
285    char *ret = NULL;
286    ret = owl_perlconfig_call_with_message(subname?subname
287                                           :"owl::_format_msg_legacy_wrap", m);
288    if (!ret) {
289      ret = owl_sprintf("@b([Perl Message Formatting Failed!])\n");
290    } 
291    return ret;
292  } else {
293    char *ptr = NULL;
294    if (owl_perlconfig_is_function("owl::receive_msg")) {
295      owl_perlconfig_call_with_message(subname?subname
296                                       :"owl::_receive_msg_legacy_wrap", m);
297    }
298    if (ptr) owl_free(ptr);
299    return(NULL);
300  }
301}
Note: See TracBrowser for help on using the repository browser.