gplugin/gplugin

a bunch of random work on the perl loader
feature/perl-loader
2015-10-06, Gary Kramlich
e6096aab1791
Parents e9f1b21ede63
Children 7655920e36f5
a bunch of random work on the perl loader
3 files changed, 73 insertions(+), 8 deletions(-)
  • +49 -0
    perl/gplugin-perl-defs.h
  • +21 -7
    perl/gplugin-perl-loader.c
  • +3 -1
    perl/tests/plugins/basic.pl
    • --- /dev/null Thu Jan 01 00:00:00 1970 +0000
    +++ b/perl/gplugin-perl-defs.h Tue Oct 06 23:20:05 2015 -0500
    @@ -0,0 +1,49 @@
    +/*
    + * Copyright (C) 2011-2015 Gary Kramlich <grim@reaperworld.com>
    + *
    + * This library is free software; you can redistribute it and/or
    + * modify it under the terms of the GNU Lesser General Public
    + * License as published by the Free Software Foundation; either
    + * version 2 of the License, or (at your option) any later version.
    + *
    + * This library is distributed in the hope that it will be useful,
    + * but WITHOUT ANY WARRANTY; without even the implied warranty of
    + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
    + * Lesser General Public License for more details.
    + *
    + * You should have received a copy of the GNU Lesser General Public
    + * License along with this library; if not, see <http://www.gnu.org/licenses/>.
    + */
    +#ifndef GPLUGIN_PERL_DEFS_H
    +#define GPLUGIN_PERL_DEFS_H
    +
    +#include <glib.h>
    +
    +const gchar gplugin_perl_definitions[] = {
    + "package GPlugin::Loader;"
    + "use Symbol;"
    +
    + "sub gplugin_load_file {"
    + "my $filename = shift;"
    + "local $/=undef;"
    + "open FH, $filename or return \"__FAILED__\";"
    + "$_ = <FH>;"
    + "close FH;"
    + "return $_;"
    + "}"
    +
    + "sub gplugin_destroy_package {"
    + "eval {"
    + "if $_[0]->can('UNLOAD') {"
    + "$_[0]->UNLOAD();"
    + "}"
    + "};"
    + "Symbol::delete_package($_[0]);"
    + "}"
    +
    + "sub gplugin_eval {"
    + "}"
    +};
    +
    +#endif /* GPLUGIN_PERL_DEFS_H */
    +
    --- a/perl/gplugin-perl-loader.c Mon Jun 29 22:05:39 2015 -0500
    +++ b/perl/gplugin-perl-loader.c Tue Oct 06 23:20:05 2015 -0500
    @@ -54,19 +54,18 @@
    PERL_SET_CONTEXT(interp);
    dSP;
    - SPAGAIN;
    ENTER;
    SAVETMPS;
    PUSHMARK(sp);
    PUTBACK;
    - call_pv(sub, G_SCALAR);
    + call_pv("gplugin_query", G_SCALAR);
    SPAGAIN;
    sinfo = POPs;
    - g_warning("sinfo: %p", sinfo);
    PUTBACK;
    + FREETMPS;
    LEAVE;
    - return NULL;
    + return sinfo;
    }
    /******************************************************************************
    @@ -90,18 +89,31 @@
    g_message("filename: %s", filename);
    + PERL_SET_CONTEXT(interp);
    interp = perl_alloc();
    - PERL_SET_CONTEXT(interp);
    + if(interp == NULL) {
    + if(error) {
    + *error = g_error_new(GPLUGIN_DOMAIN, 0, "failed to create a perl interperter");
    + }
    +
    + return NULL;
    + }
    +
    perl_construct(interp);
    PL_perl_destruct_level = 1; /* perl_construct resets this to 0 */
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
    - ret = perl_parse(interp, gplugin_perl_loader_xsinit, argc, argv, NULL);
    + ret = perl_parse(interp, gplugin_perl_loader_xsinit, argc, args, NULL);
    + g_message("ret: %d", ret);
    if(ret != 0) {
    const gchar *msg = "unknown";
    - if(SvTRUE(ERRSV))
    + if(SvTRUE(ERRSV)) {
    + g_message("got the warning");
    msg = SvPVutf8_nolen(ERRSV);
    + } else {
    + g_message("no warning");
    + }
    if(error) {
    *error = g_error_new(GPLUGIN_DOMAIN, 0,
    @@ -116,6 +128,8 @@
    info = gplugin_perl_query(interp);
    + g_message("info: %p", info);
    +
    return NULL;
    }
    --- a/perl/tests/plugins/basic.pl Mon Jun 29 22:05:39 2015 -0500
    +++ b/perl/tests/plugins/basic.pl Tue Oct 06 23:20:05 2015 -0500
    @@ -14,12 +14,14 @@
    # You should have received a copy of the GNU Lesser General Public
    # License along with this library; if not, see <http://www.gnu.org/licenses/>.
    -use strict;
    +# use strict;
    use Glib::Object::Introspection;
    Glib::Object::Introspection->setup(basename => "GPlugin", version => "0.0", package=> "GPlugin");
    +print "suck it\n";
    +
    sub gplugin_query {
    return GPlugin::PluginInfo->new(
    id => "gplugin/perl-basic-plugin",