view release on metacpan or  search on metacpan

lib/Glib/Object/Introspection.pm  view on Meta::CPAN

# Copyright (C) 2010-2014 Torsten Schoenfeld <kaffeetisch@gmx.de>
#
# This library is free software; you can redistribute it and/or modify it under
# the terms of the GNU Library General Public License as published by the Free
# Software Foundation; either version 2.1 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 Library General Public License for
# more details.
#
# See the LICENSE file in the top-level directory of this distribution for the
# full license terms.

package Glib::Object::Introspection;

use strict;
use warnings;
use Glib;

our $VERSION = '0.052';

use Carp;
$Carp::Internal{(__PACKAGE__)}++;

require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);

my @OBJECT_PACKAGES_WITH_VFUNCS;
my %SEEN;
our %_FORBIDDEN_SUB_NAMES = map { $_ => 1 } qw/AUTOLOAD CLONE DESTROY BEGIN
                                               UNITCHECK CHECK INIT END/;
our %_BASENAME_TO_PACKAGE;
our %_REBLESSERS;

sub _create_invoker_sub {
  my ($basename, $namespace, $name,
      $shift_package_name, $flatten_array_ref_return,
      $handle_sentinel_boolean) = @_;
  if ($flatten_array_ref_return && $handle_sentinel_boolean) {
    croak sprintf
      "Cannot handle the options flatten_array_ref and handle_sentinel_boolean " .
      "at the same time for %s%s::%s",
      $_BASENAME_TO_PACKAGE{$basename},
      defined $namespace ? "::$namespace" : '',
      $name;
  }
  if ($flatten_array_ref_return) {
    return sub {
      shift if $shift_package_name;
      my $ref = __PACKAGE__->invoke($basename, $namespace, $name, @_);
      return if not defined $ref;
      return wantarray ? @$ref : $ref->[$#$ref];
    };
  } elsif ($handle_sentinel_boolean) {
    return sub {
      shift if $shift_package_name;
      my ($bool, @stuff) = __PACKAGE__->invoke($basename, $namespace, $name, @_);
      return $bool
        ? @stuff[0..$#stuff] # slice to correctly behave in scalar context
        : ();
    };
  } else {
    return sub {
      shift if $shift_package_name;
      return __PACKAGE__->invoke($basename, $namespace, $name, @_);
    };
  }
}

sub setup {
  my ($class, %params) = @_;
  my $basename = $params{basename};
  my $version = $params{version};
  my $package = $params{package};
  my $search_path = $params{search_path} || undef;
  my $name_corrections = $params{name_corrections} || {};

  # Avoid repeating setting up a library as this can lead to issues, e.g., due
  # to types being registered more than once with perl-Glib.  In particular,
  # the lazy-loading mechanism of Glib::Object is not prepared to handle
  # repeated type registrations.
  if ($SEEN{$basename}{$version}{$package}++) {
    return;
  }

  $_BASENAME_TO_PACKAGE{$basename} = $package;

  my %shift_package_name_for = exists $params{class_static_methods}
    ? map { $_ => 1 } @{$params{class_static_methods}}
    : ();
  my %flatten_array_ref_return_for = exists $params{flatten_array_ref_return_for}