apps/irssi/src/perl/perl-sources.c

   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 #include "module.h"
  23 #include "signals.h"
  24
  25 #include "perl-core.h"
  26 #include "perl-common.h"
  27 #include "perl-sources.h"
  28 #include "misc.h"
  29
  30 typedef struct {
  31         PERL_SCRIPT_REC *script;
  32         int tag;
  33         int refcount;
  34         int once; /* run only once */
  35
  36         SV *func;
  37         SV *data;
  38 } PERL_SOURCE_REC;
  39
  40 static GSList *perl_sources;
  41
  42 static void perl_source_ref(PERL_SOURCE_REC *rec)
  43 {
  44         rec->refcount++;
  45 }
  46
  47 static int perl_source_unref(PERL_SOURCE_REC *rec)
  48 {
  49         if (--rec->refcount != 0)
  50                 return TRUE;
  51
  52         SvREFCNT_dec(rec->data);
  53         SvREFCNT_dec(rec->func);
  54         g_free(rec);
  55         return FALSE;
  56 }
  57
  58 static void perl_source_destroy(PERL_SOURCE_REC *rec)
  59 {
  60         perl_sources = g_slist_remove(perl_sources, rec);
  61
  62         g_source_remove(rec->tag);
  63         rec->tag = -1;
  64
  65         perl_source_unref(rec);
  66 }
  67
  68 static int perl_source_event(PERL_SOURCE_REC *rec)
  69 {
  70         dSP;
  71         int retcount;
  72
  73         ENTER;
  74         SAVETMPS;
  75
  76         PUSHMARK(SP);
  77         XPUSHs(sv_mortalcopy(rec->data));
  78         PUTBACK;
  79
  80         perl_source_ref(rec);
  81         retcount = perl_call_sv(rec->func, G_EVAL|G_SCALAR);
  82         SPAGAIN;
  83
  84         if (SvTRUE(ERRSV)) {
  85                 char *error = g_strdup(SvPV(ERRSV, PL_na));
  86                 signal_emit("script error", 2, rec->script, error);
  87                 g_free(error);
  88         }
  89
  90         if (perl_source_unref(rec) && rec->once)
  91                 perl_source_destroy(rec);
  92
  93         PUTBACK;
  94         FREETMPS;
  95         LEAVE;
  96
  97         return 1;
  98 }
  99
 100 int perl_timeout_add(int msecs, SV *func, SV *data, int once)
 101 {
 102         PERL_SCRIPT_REC *script;
 103         PERL_SOURCE_REC *rec;
 104         const char *pkg;
 105
 106         pkg = perl_get_package();
 107         script = perl_script_find_package(pkg);
 108         g_return_val_if_fail(script != NULL, -1);
 109
 110         rec = g_new0(PERL_SOURCE_REC, 1);
 111         perl_source_ref(rec);
 112
 113         rec->once = once;
 114         rec->script = script;
 115         rec->func = perl_func_sv_inc(func, pkg);
 116         rec->data = SvREFCNT_inc(data);
 117         rec->tag = g_timeout_add(msecs, (GSourceFunc) perl_source_event, rec);
 118
 119         perl_sources = g_slist_append(perl_sources, rec);
 120         return rec->tag;
 121 }
 122
 123 int perl_input_add(int source, int condition, SV *func, SV *data, int once)
 124 {
 125         PERL_SCRIPT_REC *script;
 126         PERL_SOURCE_REC *rec;
 127         const char *pkg;
 128
 129         pkg = perl_get_package();
 130         script = perl_script_find_package(pkg);
 131         g_return_val_if_fail(script != NULL, -1);
 132
 133         rec = g_new0(PERL_SOURCE_REC, 1);
 134         perl_source_ref(rec);
 135
 136         rec->once = once;
 137         rec->script =script;
 138         rec->func = perl_func_sv_inc(func, pkg);
 139         rec->data = SvREFCNT_inc(data);
 140
 141         rec->tag = g_input_add_poll(source, G_PRIORITY_DEFAULT, condition,
 142                                (GInputFunction) perl_source_event, rec);
 143
 144         perl_sources = g_slist_append(perl_sources, rec);
 145         return rec->tag;
 146 }
 147
 148 void perl_source_remove(int tag)
 149 {
 150         GSList *tmp;
 151
 152         for (tmp = perl_sources; tmp != NULL; tmp = tmp->next) {
 153                 PERL_SOURCE_REC *rec = tmp->data;
 154
 155                 if (rec->tag == tag) {
 156                         perl_source_destroy(rec);
 157                         break;
 158                 }
 159         }
 160 }
 161
 162 void perl_source_remove_script(PERL_SCRIPT_REC *script)
 163 {
 164         GSList *tmp, *next;
 165
 166         for (tmp = perl_sources; tmp != NULL; tmp = next) {
 167                 PERL_SOURCE_REC *rec = tmp->data;
 168
 169                 next = tmp->next;
 170                 if (rec->script == script)
 171                         perl_source_destroy(rec);
 172         }
 173 }
 174
 175 void perl_sources_start(void)
 176 {
 177         perl_sources = NULL;
 178 }
 179
 180 void perl_sources_stop(void)
 181 {
 182         /* timeouts and input waits */
 183         while (perl_sources != NULL)
 184                 perl_source_destroy(perl_sources->data);
 185 }