source: readconfig.c @ 0236842

barnowl_perlaimdebianowlrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 0236842 was 67103d4, checked in by Erik Nygren <nygren@mit.edu>, 22 years ago
+ Fixed bug in readconfig.c that prevented building under perl 5.005. + Switched "C-x C-x" to only "startcommand quit"
  • Property mode set to 100644
File size: 5.7 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
13
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
25
26int owl_readconfig(char *file) {
27  int ret;
28  PerlInterpreter *p;
29  char *codebuff, filename[1024];
30  char *embedding[5];
31  struct stat statbuff;
32
33  if (file==NULL) {
34    sprintf(filename, "%s/%s", getenv("HOME"), ".owlconf");
35  } else {
36    strcpy(filename, file);
37  }
38  embedding[0]="";
39  embedding[1]=filename;
40  embedding[2]=0;
41
42  /* create and initialize interpreter */
43  p=perl_alloc();
44  owl_global_set_perlinterp(&g, (void*)p);
45  perl_construct(p);
46
47  owl_global_set_no_have_config(&g);
48
49  ret=stat(filename, &statbuff);
50  if (ret) {
51    return(0);
52  }
53
54  ret=perl_parse(p, owl_perl_xs_init, 2, embedding, NULL);
55  if (ret) return(-1);
56
57  ret=perl_run(p);
58  if (ret) return(-1);
59
60  owl_global_set_have_config(&g);
61
62  /* create variables */
63  perl_get_sv("owl::id", TRUE);
64  perl_get_sv("owl::class", TRUE);
65  perl_get_sv("owl::instance", TRUE);
66  perl_get_sv("owl::recipient", TRUE);
67  perl_get_sv("owl::sender", TRUE);
68  perl_get_sv("owl::realm", TRUE);
69  perl_get_sv("owl::opcode", TRUE);
70  perl_get_sv("owl::zsig", TRUE);
71  perl_get_sv("owl::msg", TRUE);
72  perl_get_sv("owl::time", TRUE);
73  perl_get_sv("owl::host", TRUE);
74  perl_get_av("owl::fields", TRUE);
75 
76  /* perl bootstrapping code */
77  codebuff = 
78    "                                             \n"
79    "package owl;                                 \n"
80    "                                             \n"
81    "bootstrap owl 0.01;                          \n"
82    "                                             \n"
83    "package main;                                \n";
84
85  perl_eval_pv(codebuff, FALSE);
86
87
88  /* check if we have the formatting function */
89  if (perl_get_cv("owl::format_msg", FALSE)) {
90    owl_global_set_config_format(&g, 1);
91  }
92  return(0);
93}
94
95
96/* caller is responsible for freeing returned string */
97char *owl_config_execute(char *line) {
98  STRLEN len;
99  SV *response;
100  char *out, *preout;
101
102  if (!owl_global_have_config(&g)) return NULL;
103
104  /* execute the subroutine */
105  response = perl_eval_pv(line, FALSE);
106
107  preout=SvPV(response, len);
108  /* leave enough space in case we have to add a newline */
109  out = owl_malloc(strlen(preout)+2);
110  strncpy(out, preout, len);
111  out[len] = '\0';
112  if (!strlen(out) || out[strlen(out)-1]!='\n') {
113    strcat(out, "\n");
114  }
115
116  return(out);
117}
118
119char *owl_config_getmsg(owl_message *m, int mode) {
120  /* if mode==1 we are doing message formatting.  The returned
121   * formatted message needs to be freed by the caller.
122   *
123   * if mode==0 we are just doing the message-has-been-received
124   * thing.
125  */
126
127  int i, j, len;
128  char *ptr, *ptr2;
129  ZNotice_t *n;
130
131  if (!owl_global_have_config(&g)) return("");
132
133  /* set owl::msg */
134  n=owl_message_get_notice(m);
135  ptr=owl_zephyr_get_message(n, &len);
136  ptr2=owl_malloc(len+20);
137  memcpy(ptr2, ptr, len);
138  ptr2[len]='\0';
139  if (ptr2[len-1]!='\n') {
140    strcat(ptr2, "\n");
141  }
142  sv_setpv(perl_get_sv("owl::msg", TRUE), ptr2);
143  owl_free(ptr2);
144
145  /* set owl::zsig */
146  ptr=owl_zephyr_get_zsig(n, &len);
147  if (len>0) {
148    ptr2=owl_malloc(len+20);
149    memcpy(ptr2, ptr, len);
150    ptr2[len]='\0';
151    if (ptr2[len-1]=='\n') {  /* do we really need this? */
152      ptr2[len-1]='\0';
153    }
154    sv_setpv(perl_get_sv("owl::zsig", TRUE), ptr2);
155    owl_free(ptr2);
156  } else {
157    sv_setpv(perl_get_sv("owl::zsig", TRUE), "");
158  }
159
160  /* set owl::type */
161  if (owl_message_is_zephyr(m)) {
162    sv_setpv(perl_get_sv("owl::type", TRUE), "zephyr");
163  } else if (owl_message_is_admin(m)) {
164    sv_setpv(perl_get_sv("owl::type", TRUE), "admin");
165  } else {
166    sv_setpv(perl_get_sv("owl::type", TRUE), "unknown");
167  }
168
169  /* set everything else */
170  sv_setpv(perl_get_sv("owl::class", TRUE), owl_message_get_class(m));
171  sv_setpv(perl_get_sv("owl::instance", TRUE), owl_message_get_instance(m));
172  sv_setpv(perl_get_sv("owl::sender", TRUE), owl_message_get_sender(m));
173  sv_setpv(perl_get_sv("owl::realm", TRUE), owl_message_get_realm(m));
174  sv_setpv(perl_get_sv("owl::recipient", TRUE), owl_message_get_recipient(m));
175  sv_setpv(perl_get_sv("owl::opcode", TRUE), owl_message_get_opcode(m));
176  sv_setpv(perl_get_sv("owl::time", TRUE), owl_message_get_timestr(m));
177  sv_setpv(perl_get_sv("owl::host", TRUE), owl_message_get_hostname(m));
178  sv_setiv(perl_get_sv("owl::id", TRUE), owl_message_get_id(m));
179
180  /* free old @fields ? */
181  /* I don't think I need to do this, but ask marc to make sure */
182  /*
183  j=av_len(perl_get_av("fields", TRUE));
184  for (i=0; i<j; i++) {
185    tmpsv=av_pop(perl_get_av("fields", TRUE));
186    SvREFCNT_dec(tmpsv);
187  }
188  */
189
190  /* set owl::fields */
191  av_clear(perl_get_av("owl::fields", TRUE));
192  j=owl_zephyr_get_num_fields(n);
193  for (i=0; i<j; i++) {
194    ptr=owl_zephyr_get_field(n, i+1, &len);
195    ptr2=owl_malloc(len+10);
196    memcpy(ptr2, ptr, len);
197    ptr2[len]='\0';
198    av_push(perl_get_av("owl::fields", TRUE), newSVpvn(ptr2, len));
199    owl_free(ptr2);
200  }
201
202  /* for backwards compatibilty, because I'm an idiot */
203  av_clear(perl_get_av("fields", TRUE));
204  j=owl_zephyr_get_num_fields(n);
205  for (i=0; i<j; i++) {
206    ptr=owl_zephyr_get_field(n, i+1, &len);
207    ptr2=owl_malloc(len+10);
208    memcpy(ptr2, ptr, len);
209    ptr2[len]='\0';
210    av_push(perl_get_av("fields", TRUE), newSVpvn(ptr2, len));
211    owl_free(ptr2);
212  }
213
214  /* run the procedure corresponding to the mode */
215  if (mode==1) {
216    return(owl_config_execute("owl::format_msg();"));
217  } else {
218    ptr=owl_config_execute("owl::receive_msg();");
219    if (ptr) owl_free(ptr);
220    return(NULL);
221  }
222}
223
Note: See TracBrowser for help on using the repository browser.