/[weechat]/weechat/src/plugins/scripts/perl/weechat-perl.c
ViewVC logotype

Diff of /weechat/src/plugins/scripts/perl/weechat-perl.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by flashcode, Mon Oct 17 14:30:04 2005 UTC revision 1.4 by kolter, Mon Oct 24 21:33:48 2005 UTC
# Line 36  char plugin_description[] = "Perl script Line 36  char plugin_description[] = "Perl script
36  t_weechat_plugin *perl_plugin;  t_weechat_plugin *perl_plugin;
37    
38  t_plugin_script *perl_scripts = NULL;  t_plugin_script *perl_scripts = NULL;
39  t_plugin_script *current_perl_script = NULL;  t_plugin_script *perl_current_script = NULL;
40    char *perl_current_script_filename = NULL;
 static PerlInterpreter *my_perl = NULL;  
41    
42  extern void boot_DynaLoader (pTHX_ CV* cv);  extern void boot_DynaLoader (pTHX_ CV* cv);
43    
   
44  /*  /*
45   * weechat_perl_exec: execute a Perl script   * weechat_perl_exec: execute a Perl script
46   */   */
# Line 61  weechat_perl_exec (t_weechat_plugin *plu Line 59  weechat_perl_exec (t_weechat_plugin *plu
59      /* make gcc happy */      /* make gcc happy */
60      (void) script;      (void) script;
61            
62        PERL_SET_CONTEXT (script->interpreter);
63    
64      dSP;      dSP;
65      ENTER;      ENTER;
66      SAVETMPS;      SAVETMPS;
# Line 71  weechat_perl_exec (t_weechat_plugin *plu Line 71  weechat_perl_exec (t_weechat_plugin *plu
71          argv[0] = server;          argv[0] = server;
72      argv[1] = arguments;      argv[1] = arguments;
73      argv[2] = NULL;      argv[2] = NULL;
74        
75      count = perl_call_argv (function, G_EVAL | G_SCALAR, argv);      count = perl_call_argv (function, G_EVAL | G_SCALAR, argv);
76        
77      SPAGAIN;      SPAGAIN;
78            
79      sv = GvSV (gv_fetchpv ("@", TRUE, SVt_PV));      sv = GvSV (gv_fetchpv ("@", TRUE, SVt_PV));
# Line 158  static XS (XS_weechat_register) Line 160  static XS (XS_weechat_register)
160      }      }
161            
162      /* register script */      /* register script */
163      current_perl_script = weechat_script_add (perl_plugin,      perl_current_script = weechat_script_add (perl_plugin,
164                                                &perl_scripts,                                                &perl_scripts,
165                                                "",                                                "",
166                                                name, version, shutdown_func,                                                name, version, shutdown_func,
167                                                description);                                                description);
168      if (current_perl_script)      if (perl_current_script)
169      {      {
170          perl_plugin->printf_server (perl_plugin,          perl_plugin->printf_server (perl_plugin,
171                                      "Perl: registered script \"%s\", "                                      "Perl: registered script \"%s\", "
# Line 308  static XS (XS_weechat_add_message_handle Line 310  static XS (XS_weechat_add_message_handle
310            
311      name = SvPV (ST (0), integer);      name = SvPV (ST (0), integer);
312      function = SvPV (ST (1), integer);      function = SvPV (ST (1), integer);
313      perl_plugin->msg_handler_add (perl_plugin, name,      
314                                    weechat_perl_handler, function,      if (perl_current_script)
315                                    (void *)current_perl_script);          perl_plugin->msg_handler_add (perl_plugin, name,
316                                          weechat_perl_handler, function,
317                                          (void *)perl_current_script);
318        else
319        {
320            perl_plugin->printf_server (perl_plugin,
321                                          "Perl error: unable to add message handler, "
322                                          "script not initialized");
323            XSRETURN_NO;
324        }
325        
326      XSRETURN_YES;      XSRETURN_YES;
327  }  }
328    
# Line 341  static XS (XS_weechat_add_command_handle Line 353  static XS (XS_weechat_add_command_handle
353      arguments = (items >= 4) ? SvPV (ST (3), integer) : NULL;      arguments = (items >= 4) ? SvPV (ST (3), integer) : NULL;
354      arguments_description = (items >= 5) ? SvPV (ST (4), integer) : NULL;      arguments_description = (items >= 5) ? SvPV (ST (4), integer) : NULL;
355            
356      perl_plugin->cmd_handler_add (perl_plugin,      if (perl_current_script)
357                                    command,          perl_plugin->cmd_handler_add (perl_plugin,
358                                    description,                                        command,
359                                    arguments,                                        description,
360                                    arguments_description,                                        arguments,
361                                    weechat_perl_handler,                                        arguments_description,
362                                    function,                                        weechat_perl_handler,
363                                    (void *)current_perl_script);                                        function,
364                                          (void *)perl_current_script);
365        else
366        {
367            perl_plugin->printf_server (perl_plugin,
368                                          "Perl error: unable to add command handler, "
369                                          "script not initialized");
370            XSRETURN_NO;
371        }
372    
373      XSRETURN_YES;      XSRETURN_YES;
374  }  }
375    
# Line 516  weechat_perl_xs_init (pTHX) Line 537  weechat_perl_xs_init (pTHX)
537  int  int
538  weechat_perl_load (t_weechat_plugin *plugin, char *filename)  weechat_perl_load (t_weechat_plugin *plugin, char *filename)
539  {  {
540        FILE *fp;
541        PerlInterpreter *perl_current_interpreter;
542        char *perl_args[] = { "", "" };
543    
544      plugin->printf_server (plugin, "Loading Perl script \"%s\"", filename);      plugin->printf_server (plugin, "Loading Perl script \"%s\"", filename);
545      return weechat_perl_exec (plugin, NULL, "wee_perl_load_eval_file", filename, "");      
546        if ((fp = fopen (filename, "r")) == NULL)
547        {
548            plugin->printf_server (plugin,
549                                   "Perl error: unable to open file \"%s\"",
550                                   filename);
551            return 0;
552        }
553    
554        perl_current_script = NULL;
555    
556        perl_current_interpreter = perl_alloc();
557    
558        if (perl_current_interpreter == NULL)
559        {
560            plugin->printf_server (plugin,
561                                   "Perl error: unable to create new sub-interpreter");
562            fclose (fp);
563            return 0;
564        }
565    
566        PERL_SET_CONTEXT(perl_current_interpreter);
567        perl_construct(perl_current_interpreter);
568    
569        perl_args[1] = filename;
570    
571        if ( perl_parse (perl_current_interpreter, weechat_perl_xs_init, 2, perl_args, NULL) != 0 )
572        {
573            plugin->printf_server (plugin,
574                                   "Perl error: unable to parse file \"%s\"",
575                                   filename);
576            perl_destruct (perl_current_interpreter);
577            perl_free (perl_current_interpreter);
578            fclose (fp);
579            return 0;
580        }
581        
582        if ( perl_run (perl_current_interpreter) )
583        {
584            plugin->printf_server (plugin,
585                                   "Perl error: unable to run file \"%s\"",
586                                   filename);
587            perl_destruct (perl_current_interpreter);
588            perl_free (perl_current_interpreter);
589            /* if script was registered, removing from list */
590            if (perl_current_script != NULL)
591                weechat_script_remove (plugin, &perl_scripts, perl_current_script);
592            fclose (fp);
593            return 0;
594        }
595    
596        eval_pv ("$SIG{__WARN__} = sub { weechat::print \"$_[0]\", \"\"; };", TRUE);
597            
598        perl_current_script_filename = strdup (filename);
599    
600        fclose (fp);
601        free (perl_current_script_filename);
602        
603        if (perl_current_script == NULL)
604        {
605            plugin->printf_server (plugin,
606                                   "Perl error: function \"register\" not found "
607                                   "in file \"%s\"",
608                                   filename);
609            perl_destruct (perl_current_interpreter);
610            perl_free (perl_current_interpreter);
611            return 0;
612        }
613        
614        perl_current_script->interpreter = (PerlInterpreter *) perl_current_interpreter;
615        
616        return 1;
617  }  }
618    
619  /*  /*
# Line 527  weechat_perl_load (t_weechat_plugin *plu Line 623  weechat_perl_load (t_weechat_plugin *plu
623  void  void
624  weechat_perl_unload (t_weechat_plugin *plugin, t_plugin_script *script)  weechat_perl_unload (t_weechat_plugin *plugin, t_plugin_script *script)
625  {  {
626      if (script->shutdown_func && script->shutdown_func[0])      plugin->printf_server (plugin,
627          weechat_perl_exec (plugin, script, script->shutdown_func, "", "");                             "Unloading Perl script \"%s\"",
628                               script->name);
629            
630        if (script->shutdown_func[0])
631            weechat_perl_exec (plugin, script, script->shutdown_func, "", "");
632    
633        PERL_SET_CONTEXT (script->interpreter);
634        perl_destruct (script->interpreter);
635        perl_free (script->interpreter);
636      
637      weechat_script_remove (plugin, &perl_scripts, script);      weechat_script_remove (plugin, &perl_scripts, script);
638  }  }
639    
640  /*  /*
641     * weechat_perl_unload_name: unload a Perl script by name
642     */
643    
644    void
645    weechat_perl_unload_name (t_weechat_plugin *plugin, char *name)
646    {
647        t_plugin_script *ptr_script;
648        
649        ptr_script = weechat_script_search (plugin, &perl_scripts, name);
650        if (ptr_script)
651        {
652            weechat_perl_unload (plugin, ptr_script);
653            plugin->printf_server (plugin,
654                                   "Perl script \"%s\" unloaded",
655                                   name);
656        }
657        else
658        {
659            plugin->printf_server (plugin,
660                                   "Perl error: script \"%s\" not loaded",
661                                   name);
662        }
663    }
664    
665    /*
666   * weechat_perl_unload_all: unload all Perl scripts   * weechat_perl_unload_all: unload all Perl scripts
667   */   */
668    
# Line 673  weechat_perl_cmd (t_weechat_plugin *plug Line 802  weechat_perl_cmd (t_weechat_plugin *plug
802                  if (path_script)                  if (path_script)
803                      free (path_script);                      free (path_script);
804              }              }
805                else if (plugin->ascii_strcasecmp (plugin, argv[0], "unload") == 0)
806                {
807                    /* unload Perl script */
808                    weechat_perl_unload_name (plugin, argv[1]);
809                }
810              else              else
811              {              {
812                  plugin->printf_server (plugin,                  plugin->printf_server (plugin,
# Line 698  weechat_perl_cmd (t_weechat_plugin *plug Line 832  weechat_perl_cmd (t_weechat_plugin *plug
832  int  int
833  weechat_plugin_init (t_weechat_plugin *plugin)  weechat_plugin_init (t_weechat_plugin *plugin)
834  {  {
     char *perl_args[] = { "", "-e", "0" };  
     /* Following Perl code is extracted/modified from X-Chat IRC client */  
     /* X-Chat is (c) 1998-2005 Peter Zelezny */  
     char *weechat_perl_func =  
     {  
         "sub wee_perl_load_file"  
         "{"  
         "    my $filename = shift;"  
         "    local $/ = undef;"  
         "    open FILE, $filename or return \"__WEECHAT_ERROR__\";"  
         "    $_ = <FILE>;"  
         "    close FILE;"  
         "    return $_;"  
         "}"  
         "sub wee_perl_load_eval_file"  
         "{"  
         "    my $filename = shift;"  
         "    my $content = wee_perl_load_file ($filename);"  
         "    if ($content eq \"__WEECHAT_ERROR__\")"  
         "    {"  
         "        weechat::print \"Perl error: script '$filename' not found.\", \"\";"  
         "        return 1;"  
         "    }"  
         "    eval $content;"  
         "    if ($@)"  
         "    {"  
         "        weechat::print \"Perl error: unable to load script '$filename':\", \"\";"  
         "        weechat::print \"$@\";"  
         "        return 2;"  
         "    }"  
         "    return 0;"  
         "}"  
         "$SIG{__WARN__} = sub { weechat::print \"$_[0]\", \"\"; };"  
     };  
       
835      perl_plugin = plugin;      perl_plugin = plugin;
836            
837      plugin->printf_server (plugin, "Loading Perl module \"weechat\"");      plugin->printf_server (plugin, "Loading Perl module \"weechat\"");
838            
     my_perl = perl_alloc ();  
     if (!my_perl)  
     {  
         plugin->printf_server (plugin,  
                                "Perl error: unable to initialize Perl");  
         return 0;  
     }  
     perl_construct (my_perl);  
     perl_parse (my_perl, weechat_perl_xs_init, 3, perl_args, NULL);  
     eval_pv (weechat_perl_func, TRUE);  
       
839      plugin->cmd_handler_add (plugin, "perl",      plugin->cmd_handler_add (plugin, "perl",
840                               "list/load/unload Perl scripts",                               "list/load/unload Perl scripts",
841                               "[load filename] | [autoload] | [reload] | [unload]",                               "[load filename] | [autoload] | [reload] | [unload]",
# Line 774  weechat_plugin_end (t_weechat_plugin *pl Line 862  weechat_plugin_end (t_weechat_plugin *pl
862      /* unload all scripts */      /* unload all scripts */
863      weechat_perl_unload_all (plugin);      weechat_perl_unload_all (plugin);
864            
     /* free Perl interpreter */  
     if (my_perl)  
     {  
         perl_destruct (my_perl);  
         perl_free (my_perl);  
         my_perl = NULL;  
     }  
       
865      perl_plugin->printf_server (perl_plugin,      perl_plugin->printf_server (perl_plugin,
866                                  "Perl plugin ended");                                  "Perl plugin ended");
867  }  }

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26