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