%PDF- %PDF-
Direktori : /usr/lib/x86_64-linux-gnu/perl5/5.38/Glib/Object/ |
Current File : //usr/lib/x86_64-linux-gnu/perl5/5.38/Glib/Object/Introspection.pm |
# 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.051'; 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} ? map { $_ => 1 } @{$params{flatten_array_ref_return_for}} : (); my %handle_sentinel_boolean_for = exists $params{handle_sentinel_boolean_for} ? map { $_ => 1 } @{$params{handle_sentinel_boolean_for}} : (); my @use_generic_signal_marshaller_for = exists $params{use_generic_signal_marshaller_for} ? @{$params{use_generic_signal_marshaller_for}} : (); if (exists $params{reblessers}) { $_REBLESSERS{$_} = $params{reblessers}->{$_} for keys %{$params{reblessers}} } __PACKAGE__->_load_library($basename, $version, $search_path); my ($functions, $constants, $fields, $interfaces, $objects_with_vfuncs) = __PACKAGE__->_register_types($basename, $package); no strict qw(refs); no warnings qw(redefine); foreach my $namespace (keys %{$functions}) { my $is_namespaced = $namespace ne ""; NAME: foreach my $name (@{$functions->{$namespace}}) { my $auto_name = $is_namespaced ? $package . '::' . $namespace . '::' . $name : $package . '::' . $name; my $corrected_name = exists $name_corrections->{$auto_name} ? $name_corrections->{$auto_name} : $auto_name; if (defined &{$corrected_name}) { next NAME; } *{$corrected_name} = _create_invoker_sub ( $basename, $is_namespaced ? $namespace : undef, $name, $shift_package_name_for{$corrected_name}, $flatten_array_ref_return_for{$corrected_name}, $handle_sentinel_boolean_for{$corrected_name}); } } foreach my $name (@{$constants}) { my $auto_name = $package . '::' . $name; my $corrected_name = exists $name_corrections->{$auto_name} ? $name_corrections->{$auto_name} : $auto_name; # Install a sub which, on the first invocation, calls _fetch_constant and # then overrides itself with a constant sub returning that value. *{$corrected_name} = sub { my $value = __PACKAGE__->_fetch_constant($basename, $name); { *{$corrected_name} = sub { $value }; } return $value; }; } foreach my $namespace (keys %{$fields}) { foreach my $field_name (@{$fields->{$namespace}}) { my $auto_name = $package . '::' . $namespace . '::' . $field_name; my $corrected_name = exists $name_corrections->{$auto_name} ? $name_corrections->{$auto_name} : $auto_name; *{$corrected_name} = sub { my ($invocant, $new_value) = @_; my $old_value = __PACKAGE__->_get_field($basename, $namespace, $field_name, $invocant); # If a new value is provided, even if it is undef, update the field. if (scalar @_ > 1) { __PACKAGE__->_set_field($basename, $namespace, $field_name, $invocant, $new_value); } return $old_value; }; } } foreach my $name (@{$interfaces}) { my $adder_name = $package . '::' . $name . '::_ADD_INTERFACE'; *{$adder_name} = sub { my ($class, $target_package) = @_; __PACKAGE__->_add_interface($basename, $name, $target_package); }; } foreach my $object_name (@{$objects_with_vfuncs}) { my $object_package = $package . '::' . $object_name; my $installer_name = $object_package . '::_INSTALL_OVERRIDES'; *{$installer_name} = sub { my ($target_package) = @_; # Delay hooking up the vfuncs until INIT so that we can see whether the # package defines the relevant subs or not. FIXME: Shouldn't we only do # the delay dance if ${^GLOBAL_PHASE} eq 'START'? push @OBJECT_PACKAGES_WITH_VFUNCS, [$basename, $object_name, $target_package]; }; } foreach my $packaged_signal (@use_generic_signal_marshaller_for) { __PACKAGE__->_use_generic_signal_marshaller_for (@$packaged_signal); } return; } INIT { no strict qw(refs); # Hook up the implemented vfuncs first. foreach my $target (@OBJECT_PACKAGES_WITH_VFUNCS) { my ($basename, $object_name, $target_package) = @{$target}; __PACKAGE__->_install_overrides($basename, $object_name, $target_package); } # And then, for each vfunc in our ancestry that has an implementation, add a # wrapper sub to our immediate parent. We delay this step until after all # Perl overrides are in place because otherwise, the override code would see # the fallback vfuncs (via gv_fetchmethod) we are about to set up, and it # would mistake them for an actual implementation. This would then lead it # to put Perl callbacks into the vfunc slots regardless of whether the Perl # class in question actually provides implementations. my %implementer_packages_seen; foreach my $target (@OBJECT_PACKAGES_WITH_VFUNCS) { my ($basename, $object_name, $target_package) = @{$target}; my @non_perl_parent_packages = __PACKAGE__->_find_non_perl_parents($basename, $object_name, $target_package); # For each non-Perl parent, look at all the vfuncs it and its parents # provide. For each vfunc which has an implementation in the parent # (i.e. the corresponding struct pointer is not NULL), install a fallback # sub which invokes the vfunc implementation. This assumes that # @non_perl_parent_packages contains the parents in "ancestorial" order, # i.e. the first entry must be the immediate parent. IMPLEMENTER: for (my $i = 0; $i < @non_perl_parent_packages; $i++) { my $implementer_package = $non_perl_parent_packages[$i]; next IMPLEMENTER if $implementer_packages_seen{$implementer_package}++; for (my $j = $i; $j < @non_perl_parent_packages; $j++) { my $provider_package = $non_perl_parent_packages[$j]; my @vfuncs = __PACKAGE__->_find_vfuncs_with_implementation( $provider_package, $implementer_package); VFUNC: foreach my $vfunc_name (@vfuncs) { my $perl_vfunc_name = uc $vfunc_name; if (exists $_FORBIDDEN_SUB_NAMES{$perl_vfunc_name}) { $perl_vfunc_name .= '_VFUNC'; } my $full_perl_vfunc_name = $implementer_package . '::' . $perl_vfunc_name; next VFUNC if defined &{$full_perl_vfunc_name}; *{$full_perl_vfunc_name} = sub { __PACKAGE__->_invoke_fallback_vfunc($provider_package, $vfunc_name, $implementer_package, @_); } } } } } @OBJECT_PACKAGES_WITH_VFUNCS = (); } # Monkey-patch Glib with a generic constructor for boxed types. Glib cannot # provide this on its own because it does not know how big the struct of a # boxed type is. FIXME: This sort of violates encapsulation. { if (! defined &{Glib::Boxed::new}) { *{Glib::Boxed::new} = sub { my ($class, @rest) = @_; my $boxed = Glib::Object::Introspection->_construct_boxed ($class); my $fields = 1 == @rest ? $rest[0] : { @rest }; foreach my $field (keys %$fields) { if ($boxed->can ($field)) { $boxed->$field ($fields->{$field}); } } return $boxed; } } } package Glib::Object::Introspection::_FuncWrapper; use overload '&{}' => sub { my ($func) = @_; return sub { Glib::Object::Introspection::_FuncWrapper::_invoke($func, @_) } }, fallback => 1; package Glib::Object::Introspection; 1; __END__ =encoding utf8 =head1 NAME Glib::Object::Introspection - Dynamically create Perl language bindings =head1 SYNOPSIS use Glib::Object::Introspection; Glib::Object::Introspection->setup( basename => 'Gtk', version => '3.0', package => 'Gtk3'); # now GtkWindow, to mention just one example, is available as # Gtk3::Window, and you can call gtk_window_new as Gtk3::Window->new =head1 ABSTRACT Glib::Object::Introspection uses the gobject-introspection and libffi projects to dynamically create Perl bindings for a wide variety of libraries. Examples include Gtk, webkit, libsoup and many more. =head1 DESCRIPTION FOR LIBRARY USERS To allow Glib::Object::Introspection to create bindings for a library, the library must have installed a typelib file, for example C<$prefix/lib/girepository-1.0/Gtk-3.0.typelib>. In your code you then simply call C<< Glib::Object::Introspection->setup >> with the following key-value pairs to set everything up: =over =item basename => $basename The basename of the library that should be wrapped. If your typelib is called C<Gtk-3.0.typelib>, then the basename is 'Gtk'. =item version => $version The particular version of the library that should be wrapped, in string form. For C<Gtk-3.0.typelib>, it is '3.0'. =item package => $package The name of the Perl package where every class and method of the library should be rooted. If a library with basename 'Gtk' contains an class 'GtkWindow', and you pick as the package 'Gtk3', then that class will be available as 'Gtk3::Window'. =back The Perl wrappers created by C<Glib::Object::Introspection> follow the conventions of the L<Glib> module and old hand-written bindings like L<Gtk2>. You can use the included tool C<perli11ndoc> to view the documentation of all installed libraries organized and displayed in accordance with these conventions. The guiding principles underlying the conventions are described in the following. =head2 Namespaces and Objects The namespaces of the C libraries are mapped to Perl packages according to the C<package> option specified, for example: gtk_ => Gtk3 gdk_ => Gtk3::Gdk gdk_pixbuf_ => Gtk3::Gdk::Pixbuf pango_ => Pango Classes, interfaces and boxed and fundamental types get their own namespaces, in a way, as the concept of the GType is completely replaced in the Perl bindings by the Perl package name. GtkButton => Gtk3::Button GdkPixbuf => Gtk3::Gdk::Pixbuf GtkScrolledWindow => Gtk3::ScrolledWindow PangoFontDescription => Pango::FontDescription With this package mapping and Perl's built-in method lookup, the bindings can do object casting for you. This gives us a rather comfortably object-oriented syntax, using normal Perl object semantics: in C: GtkWidget * b; b = gtk_check_button_new_with_mnemonic ("_Something"); gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON (b), TRUE); gtk_widget_show (b); in Perl: my $b = Gtk3::CheckButton->new_with_mnemonic ('_Something'); $b->set_active (1); $b->show; You see from this that cast macros are not necessary and that you don't need to type namespace prefixes quite so often, so your code is a lot shorter. =head2 Flags and Enums Flags and enum values are handled as strings, because it's much more readable than numbers, and because it's automagical thanks to the GType system. Values are referred to by their nicknames; basically, strip the common prefix, lower-case it, and optionally convert '_' to '-': GTK_WINDOW_TOPLEVEL => 'toplevel' GTK_BUTTONS_OK_CANCEL => 'ok-cancel' (or 'ok_cancel') Flags are a special case. You can't (sensibly) bitwise-or these string-constants, so you provide a reference to an array of them instead. Anonymous arrays are useful here, and an empty anonymous array is a simple way to say 'no flags'. FOO_BAR_BAZ | FOO_BAR_QUU | FOO_BAR_QUUX => [qw/baz quu qux/] 0 => [] In some cases you need to see if a bit is set in a bitfield; methods returning flags therefore return an overloaded object. See L<Glib> for more details on which operations are allowed on these flag objects, but here is a quick example: in C: /* event->state is a bitfield */ if (event->state & GDK_CONTROL_MASK) g_printerr ("control was down\n"); in Perl: # $event->state is a special object warn "control was down\n" if $event->state & "control-mask"; But this also works: warn "control was down\n" if $event->state * "control-mask"; warn "control was down\n" if $event->state >= "control-mask"; warn "control and shift were down\n" if $event->state >= ["control-mask", "shift-mask"]; =head2 Memory Handling The functions for ref'ing and unref'ing objects and free'ing boxed structures are not even mapped to Perl, because it's all handled automagically by the bindings. Objects will be kept alive so long as you have a Perl scalar pointing to it or the object is referenced in another way, e.g. from a container. The only thing you have to be careful about is the lifespan of non reference counted structures, which means most things derived from C<Glib::Boxed>. If it comes from a signal callback it might be good only until you return, or if it's the insides of another object then it might be good only while that object lives. If in doubt you can C<copy>. Structs from C<copy> or C<new> are yours and live as long as referred to from Perl. =head2 Callbacks Use normal Perl callback/closure tricks with callbacks. The most common use you'll have for callbacks is with the L<Glib> C<signal_connect> method: $widget->signal_connect (event => \&event_handler, $user_data); $button->signal_connect (clicked => sub { warn "hi!\n" }); $user_data is optional, and with Perl closures you don't often need it (see L<perlsub/Persistent variables with closures>). The userdata is held in a scalar, initialized from what you give in C<signal_connect> etc. It's passed to the callback in usual Perl "call by reference" style which means the callback can modify its last argument, ie. $_[-1], to modify the held userdata. This is a little subtle, but you can use it for some "state" associated with the connection. $widget->signal_connect (activate => \&my_func, 1); sub my_func { print "activation count: $_[-1]\n"; $_[-1] ++; } Because the held userdata is a new scalar there's no change to the variable (etc.) you originally passed to C<signal_connect>. If you have a parent object in the userdata (or closure) you have to be careful about circular references preventing parent and child being destroyed. See L<perlobj/Two-Phased Garbage Collection> about this generally. Toplevel widgets like C<Gtk3::Window> always need an explicit C<< $widget->destroy >> so their C<destroy> signal is a good place to break circular references. But for other widgets it's usually friendliest to avoid circularities in the first place, either by using weak references in the userdata, or possibly locating a parent dynamically with C<< $widget->get_ancestor >>. =head2 Exception handling Anything that uses GError in C will C<croak> on failure, setting $@ to a magical exception object, which is overloaded to print as the returned error message. The ideology here is that GError is to be used for runtime exceptions, and C<croak> is how you do that in Perl. You can catch a croak very easily by wrapping the function in an eval: eval { my $pixbuf = Gtk3::Gdk::Pixbuf->new_from_file ($filename); $image->set_from_pixbuf ($pixbuf); }; if ($@) { print "$@\n"; # prints the possibly-localized error message if (Glib::Error::matches ($@, 'Gtk3::Gdk::Pixbuf::Error', 'unknown-format')) { change_format_and_try_again (); } elsif (Glib::Error::matches ($@, 'Glib::File::Error', 'noent')) { change_source_dir_and_try_again (); } else { # don't know how to handle this die $@; } } This has the added advantage of letting you bunch things together as you would with a try/throw/catch block in C++ -- you get cleaner code. By using Glib::Error exception objects, you don't have to rely on string matching on a possibly localized error message; you can match errors by explicit and predictable conditions. See L<Glib::Error> for more information. =head2 Output arguments, lists, hashes In C you can only return one value from a function, and it is a common practice to modify pointers passed in to simulate returning multiple values. In Perl, you can return lists; any functions which modify arguments are changed to return them instead. Arguments and return values that have the types GList or GSList or which are C arrays of values will be converted to and from references to normal Perl arrays. The same holds for GHashTable and references to normal Perl hashes. =head2 Object class functions Object class functions like C<Gtk3::WidgetClass::find_style_propery> can be called either with a package name or with an instance of the package. For example: Gtk3::WidgetClass::find_style_property ('Gtk3::Button', 'image-spacing') my $button = Gtk3::Button->new; Gtk3::WidgetClass::find_style_property ($button, 'image-spacing') =head2 Overriding virtual functions When subclassing a gtk+ class or when implementing a gtk+ interface with L<Glib::Object::Subclass>, you can override any virtual functions that the class has by simply defining sub routines with names obtained by capitalizing the original names of the virtual functions. So, for example, if you implement a custom subclass of C<Gtk3::CellRenderer> and want to override its virtual function C<render>, you provide a sub routine with the name C<RENDER> in your package. sub RENDER { my ($cell, $cr, $widget, $background_area, $cell_area, $flags) = @_; # do something } =head1 DESCRIPTION FOR LIBRARY BINDING AUTHORS =head2 C<< Glib::Object::Introspection->setup >> C<< Glib::Object::Introspection->setup >> takes a few optional arguments that augment the generated API: =over =item search_path => $search_path A path that should be used when looking for typelibs. If you use typelibs from system directories, or if your environment contains a properly set C<GI_TYPELIB_PATH> variable, then this should not be necessary. =item name_corrections => { auto_name => new_name, ... } A hash ref that is used to rename functions and methods. Use this if you don't like the automatically generated mapping for a function or method. For example, if C<g_file_hash> is automatically represented as C<Glib::IO::file_hash> but you want C<Glib::IO::File::hash> then pass name_corrections => { 'Glib::IO::file_hash' => 'Glib::IO::File::hash' } =item class_static_methods => [ function1, ... ] An array ref of function names that you want to be treated as class-static methods. That is, if you want be able to call C<Gtk3::Window::list_toplevels> as C<< Gtk3::Window->list_toplevels >>, then pass class_static_methods => [ 'Gtk3::Window::list_toplevels' ] The function names refer to those after name corrections. =item flatten_array_ref_return_for => [ function1, ... ] An array ref of function names that return an array ref that you want to be flattened so that they return plain lists. For example flatten_array_ref_return_for => [ 'Gtk3::Window::list_toplevels' ] The function names refer to those after name corrections. Functions occurring in C<flatten_array_ref_return_for> may also occur in C<class_static_methods>. =item handle_sentinel_boolean_for => [ function1, ... ] An array ref of function names that return multiple values, the first of which is to be interpreted as indicating whether the rest of the returned values are valid. This frequently occurs with functions that have out arguments; the boolean then indicates whether the out arguments have been written. With C<handle_sentinel_boolean_for>, the first return value is taken to be the sentinel boolean. If it is true, the rest of the original return values will be returned, and otherwise an empty list will be returned. handle_sentinel_boolean_for => [ 'Gtk3::TreeSelection::get_selected' ] The function names refer to those after name corrections. Functions occurring in C<handle_sentinel_boolean_for> may also occur in C<class_static_methods>. =item use_generic_signal_marshaller_for => [ [package1, signal1, [arg_converter1]], ... ] Use an introspection-based generic signal marshaller for the signal C<signal1> of type C<package1>. If given, use the code reference C<arg_converter1> to convert the arguments that are passed to the signal handler. In contrast to L<Glib>'s normal signal marshaller, the generic signal marshaller supports, among other things, pointer arrays and out arguments. =item reblessers => { package => \&reblesser, ... } Tells G:O:I to invoke I<reblesser> whenever a Perl object is created for an object of type I<package>. Currently, this only applies to boxed unions. The reblesser gets passed the pre-created Perl object and needs to return the modified Perl object. For example: sub Gtk3::Gdk::Event::_rebless { my ($event) = @_; return bless $event, lookup_real_package_for ($event); } =back =head2 C<< Glib::Object::Introspection->invoke >> To invoke specific functions manually, you can use the low-level C<< Glib::Object::Introspection->invoke >>. Glib::Object::Introspection->invoke( $basename, $namespace, $function, @args) =over =item * $basename is the basename of a library, like 'Gtk'. =item * $namespace refers to a namespace inside that library, like 'Window'. Use undef here if you want to call a library-global function. =item * $function is the name of the function you want to invoke. It can also refer to the name of a constant. =item * @args are the arguments that should be passed to the function. For a method, this should include the invocant. For a constructor, this should include the package name. =back C<< Glib::Object::Introspection->invoke >> returns whatever the function being invoked returns. =head2 Overrides To override the behavior of a specific function or method, create an appropriately named sub in the correct package and have it call C<< Glib::Object::Introspection->invoke >>. Say you want to override C<Gtk3::Window::list_toplevels>, then do this: sub Gtk3::Window::list_toplevels { # ...do something... my $ref = Glib::Object::Introspection->invoke ( 'Gtk', 'Window', 'list_toplevels', @_); # ...do something... return wantarray ? @$ref : $ref->[$#$ref]; } The sub's name and package must be those after name corrections. =head2 Converting a Perl variable to a GValue If you need to marshal into a GValue, then Glib::Object::Introspection cannot do this automatically because the type information is missing. If you do have this information in your module, however, you can use Glib::Object::Introspection::GValueWrapper to do the conversion. In the wrapper for a function that expects a GValue, do this: ... my $type = ...; # somehow get the package name that # corresponds to the correct GType my $wrapper = Glib::Object::Introspection::GValueWrapper->new ($type, $value); # now use Glib::Object::Introspection->invoke and # substitute $wrapper where you'd use $value ... If you need to call a function that expects an already set-up GValue and modifies it, use C<get_value> on the wrapper afterwards to obtain the value. For example: my $wrapper = Glib::Object::Introspection::GValueWrapper->new ('Glib::Boolean', 0); $box->child_get_property ($label, 'expand', $gvalue); my $value = $gvalue->get_value =head2 Handling raw enumerations and flags If you need to handle raw enumerations/flags or extendable enumerations for which more than the pre-defined values might be valid, then use C<< Glib::Object::Introspection->convert_enum_to_sv >>, C<< Glib::Object::Introspection->convert_sv_to_enum >>, C<< Glib::Object::Introspection->convert_flags_to_sv >> and C<< Glib::Object::Introspection->convert_sv_to_flags >>. They will raise an exception on unknown values; catching it then allows you to implement fallback behavior. Glib::Object::Introspection->convert_enum_to_sv (package, enum_value) Glib::Object::Introspection->convert_sv_to_enum (package, sv) Glib::Object::Introspection->convert_flags_to_sv (package, flags_value) Glib::Object::Introspection->convert_sv_to_flags (package, sv) =head1 SEE ALSO =over =item perl-Glib: L<Glib> =item gobject-introspection: L<https://gi.readthedocs.io/en/latest/> =item libffi: L<http://sourceware.org/libffi/> =back =head1 AUTHORS =over =item Emmanuele Bassi <ebassi at gnome org> =item muppet <scott asofyet org> =item Torsten Schönfeld <kaffeetisch at gmx de> =back =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the terms of the Lesser General Public License (LGPL). For more information, see http://www.fsf.org/licenses/lgpl.txt =cut