# 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.032';

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 Miscellaneous

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.

You don't need to specify string lengths.  You can always use C<substr> to pass

different parts of a string.

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.

=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 occuring

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 occuring

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 $real_value =

    Glib::Object::Introspection::GValueWrapper->new ($type, $value);

  # now use Glib::Object::Introspection->invoke and

  # substitute $real_value where you'd use $value

  ...

=head2 Handling extendable enumerations

If you need to handle extendable enumerations for which more than the

pre-defined values might be valid, then use C<<

Glib::Object::Introspection->convert_enum_to_sv >> and C<<

Glib::Object::Introspection->convert_sv_to_enum >>.  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)

=head1 SEE ALSO

=over

=item perl-Glib: L<Glib>

=item gobject-introspection: L<http://live.gnome.org/GObjectIntrospection>

=item libffi: L<http://sourceware.org/libffi/>

=back

=head1 AUTHORS

=over

=item Emmanuele Bassi <ebassi at linux intel com>

=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