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
  17     along with this program; if not, write to the Free Software
  18     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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
  29 typedef struct {
  30         PERL_SCRIPT_REC *script;
  31         int tag;
  32         int refcount;
  33         int once; /* run only once */
  34
  35         SV *func;
  36         SV *data;
  37 } PERL_SOURCE_REC;
  38
  39 static GSList *perl_sources;
  40
  41 static void perl_source_ref(PERL_SOURCE_REC *rec)
  42 {
  43         rec->refcount++;
  44 }
  45
  46 static int perl_source_unref(PERL_SOURCE_REC *rec)
  47 {
  48         if (--rec->refcount != 0)
  49                 return TRUE;
  50
  51         SvREFCNT_dec(rec->data);
  52         SvREFCNT_dec(rec->func);
  53         g_free(rec);
  54         return FALSE;
  55 }
  56
  57 static void perl_source_destroy(PERL_SOURCE_REC *rec)
  58 {
  59         perl_sources = g_slist_remove(perl_sources, rec);
  60
  61         g_source_remove(rec->tag);
  62         rec->tag = -1;
  63
  64         perl_source_unref(rec);
  65 }
  66
  67 static int perl_source_event(PERL_SOURCE_REC *rec)
  68 {
  69         dSP;
  70         int retcount;
  71
  72         ENTER;
  73         SAVETMPS;
  74
  75         PUSHMARK(SP);
  76         XPUSHs(sv_mortalcopy(rec->data));
  77         PUTBACK;
  78
  79         perl_source_ref(rec);
  80         retcount = perl_call_sv(rec->func, G_EVAL|G_SCALAR);
  81         SPAGAIN;
  82
  83         if (SvTRUE(ERRSV)) {
  84                 char *error = g_strdup(SvPV(ERRSV, PL_na));
  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         PUTBACK;
  93         FREETMPS;
  94         LEAVE;
  95
  96         return 1;
  97 }
  98
  99 int perl_timeout_add(int msecs, SV *func, SV *data, int once)
 100 {
 101         PERL_SCRIPT_REC *script;
 102         PERL_SOURCE_REC *rec;
 103         const char *pkg;
 104
 105         pkg = perl_get_package();
 106         script = perl_script_find_package(pkg);
 107         g_return_val_if_fail(script != NULL, -1);
 108
 109         rec = g_new0(PERL_SOURCE_REC, 1);
 110         perl_source_ref(rec);
 111
 112         rec->once = once;
 113         rec->script = script;
 114         rec->func = perl_func_sv_inc(func, pkg);
 115         rec->data = SvREFCNT_inc(data);
 116         rec->tag = g_timeout_add(msecs, (GSourceFunc) perl_source_event, rec);
 117
 118         perl_sources = g_slist_append(perl_sources, rec);
 119         return rec->tag;
 120 }
 121
 122 int perl_input_add(int source, int condition, SV *func, SV *data, int once)
 123 {
 124         PERL_SCRIPT_REC *script;
 125         PERL_SOURCE_REC *rec;
 126         GIOChannel *channel;
 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         channel = g_io_channel_unix_new(source);
 142         rec->tag = g_input_add(channel, condition,
 143                                (GInputFunction) perl_source_event, rec);
 144         g_io_channel_unref(channel);
 145
 146         perl_sources = g_slist_append(perl_sources, rec);
 147         return rec->tag;
 148 }
 149
 150 void perl_source_remove(int tag)
 151 {
 152         GSList *tmp;
 153
 154         for (tmp = perl_sources; tmp != NULL; tmp = tmp->next) {
 155                 PERL_SOURCE_REC *rec = tmp->data;
 156
 157                 if (rec->tag == tag) {
 158                         perl_source_destroy(rec);
 159                         break;
 160                 }
 161         }
 162 }
 163
 164 void perl_source_remove_script(PERL_SCRIPT_REC *script)
 165 {
 166         GSList *tmp, *next;
 167
 168         for (tmp = perl_sources; tmp != NULL; tmp = next) {
 169                 PERL_SOURCE_REC *rec = tmp->data;
 170
 171                 next = tmp->next;
 172                 if (rec->script == script)
 173                         perl_source_destroy(rec);
 174         }
 175 }
 176
 177 void perl_sources_start(void)
 178 {
 179         perl_sources = NULL;
 180 }
 181
 182 void perl_sources_stop(void)
 183 {
 184         /* timeouts and input waits */
 185         while (perl_sources != NULL)
 186                 perl_source_destroy(perl_sources->data);
 187 }