1 /*
2 perl-sources.c : irssi
3
4 Copyright (C) 1999-2001 Timo Sirainen
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License along
17 with this program; if not, write to the Free Software Foundation, Inc.,
18 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 */
20
21 #define NEED_PERL_H
22 #define PERL_NO_GET_CONTEXT
23 #include "module.h"
24 #include "signals.h"
25
26 #include "perl-core.h"
27 #include "perl-common.h"
28 #include "perl-sources.h"
29 #include "misc.h"
30
31 typedef struct {
32 PERL_SCRIPT_REC *script;
33 int tag;
34 int refcount;
35 int once; /* run only once */
36
37 SV *func;
38 SV *data;
39 } PERL_SOURCE_REC;
40
41 static GSList *perl_sources;
42
perl_source_ref(PERL_SOURCE_REC * rec)43 static void perl_source_ref(PERL_SOURCE_REC *rec)
44 {
45 rec->refcount++;
46 }
47
perl_source_unref(PERL_SOURCE_REC * rec)48 static int perl_source_unref(PERL_SOURCE_REC *rec)
49 {
50 if (--rec->refcount != 0)
51 return TRUE;
52
53 SvREFCNT_dec(rec->data);
54 SvREFCNT_dec(rec->func);
55 g_free(rec);
56 return FALSE;
57 }
58
perl_source_destroy(PERL_SOURCE_REC * rec)59 static void perl_source_destroy(PERL_SOURCE_REC *rec)
60 {
61 perl_sources = g_slist_remove(perl_sources, rec);
62
63 g_source_remove(rec->tag);
64 rec->tag = -1;
65
66 perl_source_unref(rec);
67 }
68
perl_source_event(PERL_SOURCE_REC * rec)69 static int perl_source_event(PERL_SOURCE_REC *rec)
70 {
71 dSP;
72
73 ENTER;
74 SAVETMPS;
75
76 PUSHMARK(SP);
77 XPUSHs(sv_mortalcopy(rec->data));
78 PUTBACK;
79
80 perl_source_ref(rec);
81 perl_call_sv(rec->func, G_EVAL|G_DISCARD);
82
83 if (SvTRUE(ERRSV)) {
84 char *error = g_strdup(SvPV_nolen(ERRSV));
85 signal_emit("script error", 2, rec->script, error);
86 g_free(error);
87 }
88
89 if (perl_source_unref(rec) && rec->once)
90 perl_source_destroy(rec);
91
92 FREETMPS;
93 LEAVE;
94
95 return 1;
96 }
97
perl_timeout_add(int msecs,SV * func,SV * data,int once)98 int perl_timeout_add(int msecs, SV *func, SV *data, int once)
99 {
100 PERL_SCRIPT_REC *script;
101 PERL_SOURCE_REC *rec;
102 const char *pkg;
103
104 pkg = perl_get_package();
105 script = perl_script_find_package(pkg);
106 g_return_val_if_fail(script != NULL, -1);
107
108 rec = g_new0(PERL_SOURCE_REC, 1);
109 perl_source_ref(rec);
110
111 rec->once = once;
112 rec->script = script;
113 rec->func = perl_func_sv_inc(func, pkg);
114 rec->data = SvREFCNT_inc(data);
115 rec->tag = g_timeout_add(msecs, (GSourceFunc) perl_source_event, rec);
116
117 perl_sources = g_slist_append(perl_sources, rec);
118 return rec->tag;
119 }
120
perl_input_add(int source,int condition,SV * func,SV * data,int once)121 int perl_input_add(int source, int condition, SV *func, SV *data, int once)
122 {
123 PERL_SCRIPT_REC *script;
124 PERL_SOURCE_REC *rec;
125 const char *pkg;
126
127 pkg = perl_get_package();
128 script = perl_script_find_package(pkg);
129 g_return_val_if_fail(script != NULL, -1);
130
131 rec = g_new0(PERL_SOURCE_REC, 1);
132 perl_source_ref(rec);
133
134 rec->once = once;
135 rec->script =script;
136 rec->func = perl_func_sv_inc(func, pkg);
137 rec->data = SvREFCNT_inc(data);
138
139 rec->tag = g_input_add_poll(source, G_PRIORITY_DEFAULT, condition,
140 (GInputFunction) perl_source_event, rec);
141
142 perl_sources = g_slist_append(perl_sources, rec);
143 return rec->tag;
144 }
145
perl_source_remove(int tag)146 void perl_source_remove(int tag)
147 {
148 GSList *tmp;
149
150 for (tmp = perl_sources; tmp != NULL; tmp = tmp->next) {
151 PERL_SOURCE_REC *rec = tmp->data;
152
153 if (rec->tag == tag) {
154 perl_source_destroy(rec);
155 break;
156 }
157 }
158 }
159
perl_source_remove_script(PERL_SCRIPT_REC * script)160 void perl_source_remove_script(PERL_SCRIPT_REC *script)
161 {
162 GSList *tmp, *next;
163
164 for (tmp = perl_sources; tmp != NULL; tmp = next) {
165 PERL_SOURCE_REC *rec = tmp->data;
166
167 next = tmp->next;
168 if (rec->script == script)
169 perl_source_destroy(rec);
170 }
171 }
172
perl_sources_start(void)173 void perl_sources_start(void)
174 {
175 perl_sources = NULL;
176 }
177
perl_sources_stop(void)178 void perl_sources_stop(void)
179 {
180 /* timeouts and input waits */
181 while (perl_sources != NULL)
182 perl_source_destroy(perl_sources->data);
183 }
184