[glibmm/gmmproc-refactor] Add new conversions and type info system.
- From: Krzesimir Nowak <krnowak src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [glibmm/gmmproc-refactor] Add new conversions and type info system.
- Date: Wed, 6 Jun 2012 07:12:17 +0000 (UTC)
commit 0799dbb37430b05c6e06c70d33646622723e6c3a
Author: Krzesimir Nowak <qdlacz gmail com>
Date: Wed Jun 6 03:34:40 2012 +0200
Add new conversions and type info system.
New conversions system allows us to specify conversion in general
manner like:
GtkWidget <=> Gtk::Widget ## NORMAL
so we do not need to write every possible specific conversion
out there.
tools/pm/Common/TypeDetails.pm | 213 ++++
tools/pm/Common/TypeDetails/Base.pm | 218 ++++
tools/pm/Common/TypeDetails/Container.pm | 136 +++
tools/pm/Common/TypeDetails/Value.pm | 251 +++++
tools/pm/Common/TypeInfo.pm | 31 +
tools/pm/Common/TypeInfo/Common.pm | 142 +++
tools/pm/Common/TypeInfo/Convertors.pm | 35 +
tools/pm/Common/TypeInfo/Convertors/Enum.pm | 53 +
tools/pm/Common/TypeInfo/Convertors/Equal.pm | 66 ++
tools/pm/Common/TypeInfo/Convertors/Func.pm | 33 +
tools/pm/Common/TypeInfo/Convertors/Manual.pm | 31 +
tools/pm/Common/TypeInfo/Convertors/Normal.pm | 32 +
tools/pm/Common/TypeInfo/Convertors/Reffed.pm | 254 +++++
tools/pm/Common/TypeInfo/Convertors/StdString.pm | 289 +++++
tools/pm/Common/TypeInfo/Convertors/Ustring.pm | 289 +++++
tools/pm/Common/TypeInfo/Global.pm | 1310 ++++++++++++++++++++++
tools/pm/Common/TypeInfo/Local.pm | 94 ++
17 files changed, 3477 insertions(+), 0 deletions(-)
---
diff --git a/tools/pm/Common/TypeDetails.pm b/tools/pm/Common/TypeDetails.pm
new file mode 100644
index 0000000..2825109
--- /dev/null
+++ b/tools/pm/Common/TypeDetails.pm
@@ -0,0 +1,213 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeDetails::Base module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeDetails;
+
+use strict;
+use warnings;
+
+use Common::TypeDetails::Base;
+use Common::TypeDetails::Container;
+use Common::TypeDetails::Value;
+
+#
+# That does not support function types ('int (*)(int,
+# double)').
+#
+# PTR_TYPE -> [VAL_TYPE, REF_TYPE, PTR_TYPE, FUN_TYPE(x)]
+# REF_TYPE -> [VAL_TYPE, REF_TYPE(?), PTR_TYPE(x)]
+# VAL_TYPE -> NIL
+# FUN_TYPE(x) -> NIL
+#
+# (x) - NIH
+# (?) - incorrect in C++
+#
+sub disassemble_type ($);
+
+sub disassemble_type ($)
+{
+ my ($cxx_type_or_array_ref) = @_;
+ my $parameter_ref = ref $cxx_type_or_array_ref;
+ my $parts = undef;
+ unless ($parameter_ref)
+ {
+ # string was passed
+ my @temp_parts = reverse split /(\w+|[()*&<>,`']|::)/, $cxx_type_or_array_ref;
+
+ $parts = \ temp_parts;
+ }
+ elsif ($parameter_ref eq 'ARRAY')
+ {
+ # array ref was passed
+ $parts = $cxx_type_or_array_ref;
+ }
+ die unless defined $parts;
+
+ my $const = 0;
+ my $volatile = 0;
+
+ while (@{$parts})
+ {
+ my $part = shift @{$parts};
+
+ next if (not defined $part or $part eq '');
+
+ if ($part eq 'const')
+ {
+ die if $const;
+ $const = 1;
+ }
+ elsif ($part eq 'volatile')
+ {
+ die if $volatile;
+ $volatile = 1;
+ }
+ elsif ($part eq '*' or $part eq '&')
+ {
+ # this is container type - either pointer or reference.
+ my $contained_type = disassemble_type $parts;
+
+ return Common::TypeDetails::Container->new ($const,
+ $volatile,
+ $contained_type,
+ $part);
+ }
+ elsif ($part !~ /^\s+$/)
+ {
+ # this is value type, put token back and continue
+ # parsing in another loop.
+ unshift @{$parts}, $part;
+ last;
+ }
+ }
+
+ my @template_parts = ();
+ my $template_level = 0;
+ my $template = undef;
+ my @type_parts = ();
+ my $base_type = '';
+ my $imbue_type = undef;
+ my $collect_imbue_type = 0;
+ my @imbue_parts = ();
+
+ foreach my $part (@{$parts})
+ {
+ next if $part eq '';
+
+ if ($collect_imbue_type)
+ {
+ my $gather_parts = 0;
+
+ if ($part eq '`')
+ {
+ $gather_parts = 1;
+ $collect_imbue_type = 0;
+ }
+ elsif ($part eq ',')
+ {
+ $gather_parts = 1;
+ }
+
+ if ($gather_parts)
+ {
+ push @{$imbue_type}, join ('', @imbue_parts);
+ @imbue_parts = ();
+ }
+ else
+ {
+ push @imbue_parts, $part;
+ }
+ }
+ elsif ($template_level)
+ {
+ ++$template_level if ($part eq '>');
+ --$template_level if ($part eq '<');
+
+ if ($template_level == 0 or ($template_level == 1 and $part eq ','))
+ {
+ my $template_type = disassemble_type \ template_parts;
+
+ push @{$template}, $template_type;
+ @template_parts = ();
+ }
+ else
+ {
+ push @template_parts, $part;
+ }
+ }
+ elsif ($part eq '>')
+ {
+ die if defined $template;
+ die if defined $imbue_type;
+ $template_level = 1;
+ $template = [];
+ }
+ elsif ($part eq 'const')
+ {
+ # there cannot be any modifiers between template/imbue type and
+ # base type.
+ die if ((defined ($template) or defined ($imbue_type)) and @type_parts == 0);
+ die if $const;
+ $const = 1;
+ }
+ elsif ($part eq 'volatile')
+ {
+ # there cannot be any modifiers between template/imbue type and
+ # base type.
+ die if ((defined ($template) or defined ($imbue_type)) and @type_parts == 0);
+ die if $volatile;
+ $volatile = 1;
+ }
+ elsif ($part eq '\'')
+ {
+ die if defined $template;
+ die if defined $imbue_type;
+ $collect_imbue_type = 1;
+ $imbue_type = [];
+ }
+ elsif ($part =~ /^[,&*]$/)
+ {
+ die;
+ }
+ elsif ($part !~ /^\s+$/)
+ {
+ push @type_parts, $part;
+ }
+ }
+
+ $base_type = join '', reverse @type_parts;
+
+ unless (defined ($template))
+ {
+ $template = [];
+ }
+ unless (defined ($imbue_type))
+ {
+ $imbue_type = [];
+ }
+
+ return Common::TypeDetails::Value->new ($const,
+ $volatile,
+ $base_type,
+ $template,
+ $imbue_type);
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeDetails/Base.pm b/tools/pm/Common/TypeDetails/Base.pm
new file mode 100644
index 0000000..6b2fa6a
--- /dev/null
+++ b/tools/pm/Common/TypeDetails/Base.pm
@@ -0,0 +1,218 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeDetails::Base module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeDetails::Base;
+
+use strict;
+use warnings;
+
+use constant
+{
+ NONE => 0,
+ BASE => 1 << 0,
+ ACCESS_MODIFIERS => (1 << 1),
+ STRUCTURE => 1 << 2,
+ RECURSIVE => 1 << 2 | 1 << 3 # recursive check forces structure equality
+};
+
+sub _get_split_values ($)
+{
+ return '?cv';
+}
+
+sub _get_sigil ($)
+{
+ my ($self) = @_;
+
+ return $self->{'sigil'};
+}
+
+sub _tokenize ($$)
+{
+ my ($self, $match) = @_;
+ my $split_values = $self->_get_split_values ();
+ my @preliminary_tokens = split (/([$split_values])/, $match);
+ my @final_tokens = ();
+
+ foreach my $token (@preliminary_tokens)
+ {
+ if (defined $token and $token ne '')
+ {
+ unshift (@final_tokens, $token);
+ }
+ }
+
+ return \ final_tokens;
+}
+
+sub new ($$$$)
+{
+ my ($type, $const, $volatile, $sigil) = @_;
+ my $class = (ref $type or $type or 'Common::TypeDetails::Base');
+ my $self =
+ {
+ 'const' => $const,
+ 'volatile' => $volatile,
+ 'sigil' => $sigil
+ };
+
+ return bless $self, $class;
+}
+
+sub get_value_details ($)
+{
+# TODO: not implemented error.
+ die;
+}
+
+sub match_sigil ($$$)
+{
+# TODO: not implemented error.
+ die;
+}
+
+sub match_basic_sigil ($$$)
+{
+ my ($self, $match, $flags) = @_;
+ my $const_checked = 0;
+ my $volatile_checked = 0;
+ my $do_not_care = 0;
+ my $drop = 0;
+
+ unless (defined ($flags))
+ {
+ $flags = NONE;
+ }
+
+ my $check = (($flags & ACCESS_MODIFIERS) == ACCESS_MODIFIERS);
+
+ foreach my $index (-1, -2, -3)
+ {
+ my $char = '';
+
+ if (length ($match) >= -$index)
+ {
+ $char = substr ($match, $index, 1);
+ }
+
+ if ($char eq 'c')
+ {
+ if ($do_not_care or $const_checked or ($check and not $self->get_const ()))
+ {
+ return undef;
+ }
+ $const_checked = 1;
+ ++$drop;
+ }
+ elsif ($char eq 'v')
+ {
+ if ($do_not_care or $volatile_checked or ($check and not $self->get_volatile ()))
+ {
+ return undef;
+ }
+ $volatile_checked = 0;
+ ++$drop;
+ }
+ elsif ($char eq '?')
+ {
+ if ($const_checked or $volatile_checked or $do_not_care)
+ {
+ return undef;
+ }
+ $do_not_care = 1;
+ ++$drop;
+ }
+ else
+ {
+ last;
+ }
+ }
+
+ if ($check and ((not $const_checked and $self->get_const ()) or (not $volatile_checked and $self->get_volatile ())))
+ {
+ return undef;
+ }
+
+ if ($drop)
+ {
+ return substr ($match, 0, -$drop);
+ }
+ return $match;
+}
+
+sub equal ($$$)
+{
+ my ($self, $other, $flags) = @_;
+
+ if ($flags & ACCESS_MODIFIERS == ACCESS_MODIFIERS)
+ {
+ if ($self->get_const () != $other->get_const () or
+ $self->get_volatile () != $other->get_volatile ())
+ {
+ return 0;
+ }
+ }
+
+ if ((($flags & STRUCTURE) == STRUCTURE) and $self->_get_sigil () ne $other->_get_sigil ())
+ {
+ return 0;
+ }
+
+ return 1;
+}
+
+sub get_string ($)
+{
+# TODO: not implemented error
+ die;
+}
+
+sub get_basic_string ($)
+{
+ my ($self) = @_;
+ my @str = ();
+
+ if ($self->get_const ())
+ {
+ push (@str, 'const');
+ }
+ if ($self->get_volatile ())
+ {
+ push (@str, 'volatile');
+ }
+
+ return join (' ', @str);
+}
+
+sub get_const ($)
+{
+ my ($self) = @_;
+
+ return $self->{'const'};
+}
+
+sub get_volatile ($)
+{
+ my ($self) = @_;
+
+ return $self->{'volatile'};
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeDetails/Container.pm b/tools/pm/Common/TypeDetails/Container.pm
new file mode 100644
index 0000000..b666059
--- /dev/null
+++ b/tools/pm/Common/TypeDetails/Container.pm
@@ -0,0 +1,136 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeDetails::Container module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeDetails::Container;
+
+use strict;
+use warnings;
+
+use parent qw(Common::TypeDetails::Base);
+
+sub _get_contained_type ($)
+{
+ my ($self) = @_;
+
+ return $self->{'contained_type'};
+}
+
+sub _get_sigil ($)
+{
+ my ($self) = @_;
+
+ return $self->{'sigil'};
+}
+
+sub _get_split_values ($)
+{
+ my ($self) = @_;
+ my $sigil = $self->_get_sigil ();
+
+ return join ('', $self->SUPER::_get_split_values (), $sigil);
+}
+
+sub new ($$$)
+{
+ my ($type, $const, $volatile, $contained_type, $sigil) = @_;
+ my $class = (ref $type or $type or 'Common::TypeDetails::Container');
+ my $self = $class->SUPER::new ($const, $volatile, $sigil);
+
+ $self->{'contained_type'} = $contained_type;
+
+ return bless $self, $class;
+}
+
+sub get_value_details ($)
+{
+ my ($self) = @_;
+ my $contained_type = $self->_get_contained_type;
+
+ return $contained_type->get_value_details;
+}
+
+sub match_sigil ($$$)
+{
+ my ($self, $matches, $flags) = @_;
+ my $sigil = $self->_get_sigil ();
+
+ unless (ref ($matches))
+ {
+ $matches = [$matches];
+ }
+ unless (defined ($flags))
+ {
+ $flags = Common::TypeDetails::Base::NONE;
+ }
+
+ foreach my $match (@{$matches})
+ {
+ $match = $self->match_basic_sigil ($match, $flags);
+
+ next unless (defined $match);
+
+ my $tokens = $self->_tokenize ($match);
+
+ if (@{$tokens} and $tokens->[0] eq $sigil)
+ {
+ my $contained_type = $self->_get_contained_type ();
+ my $sub_match = substr ($match, 0, -1);
+ my $matched = $contained_type->match_sigil ($sub_match, $flags);
+
+ if ($matched)
+ {
+ return $matched;
+ }
+ }
+ }
+ return 0;
+}
+
+sub get_string ($)
+{
+ my ($self) = @_;
+ my $contained_type = $self->_get_contained_type ();
+ my $sigil = self->_get_sigil ();
+ my $basic_string = $self->get_basic_string ();
+
+ return ($contained_type->get_string () . $sigil . ($basic_string ? ' ' . $basic_string : ''));
+}
+
+sub equal ($$$)
+{
+ my ($self, $other, $flags) = @_;
+
+ unless ($self->SUPER::equal ($other, $flags))
+ {
+ return 0;
+ }
+
+ if (($flags & Common::TypeDetails::Base::RECURSIVE) == Common::TypeDetails::Base::RECURSIVE)
+ {
+ my $self_contained_type = $self->_get_contained_type;
+ my $other_contained_type = $self->_get_contained_type;
+
+ return $self_contained_type->equal ($other_contained_type);
+ }
+
+ return 1;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeDetails/Value.pm b/tools/pm/Common/TypeDetails/Value.pm
new file mode 100644
index 0000000..672ac43
--- /dev/null
+++ b/tools/pm/Common/TypeDetails/Value.pm
@@ -0,0 +1,251 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeDetails::Value module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeDetails::Value;
+
+use strict;
+use warnings;
+
+use parent qw(Common::TypeDetails::Base);
+
+sub _get_split_values ($)
+{
+ my ($self) = @_;
+
+ return join ('', $self->SUPER::_get_split_values (), '<>,!#');
+}
+
+sub new ($$$$$$)
+{
+ my ($type, $const, $volatile, $base, $templates, $imbue_type) = @_;
+ my $class = (ref $type or $type or 'Common::TypeDetails::Value');
+ my $self = $class->SUPER::new ($const, $volatile, '');
+
+ $self->{'base'} = $base;
+ $self->{'templates'} = $templates;
+ $self->{'imbue_type'} = $imbue_type;
+
+ return bless $self, $class;
+}
+
+sub get_base ($)
+{
+ my ($self) = @_;
+
+ return $self->{'base'};
+}
+
+sub get_templates ($)
+{
+ my ($self) = @_;
+
+ return $self->{'templates'};
+}
+
+sub get_imbue_type ($)
+{
+ my ($self) = @_;
+
+ return $self->{'imbue_type'};
+}
+
+sub get_value_details ($)
+{
+ my ($self) = @_;
+
+ return $self;
+}
+
+sub match_sigil ($$$)
+{
+ my ($self, $matches, $flags) = @_;
+
+ unless (ref ($matches))
+ {
+ $matches = [$matches];
+ }
+ unless (defined ($flags))
+ {
+ $flags = Common::TypeDetails::Base::NONE;
+ }
+
+ foreach my $match (@{$matches})
+ {
+ $match = $self->match_basic_sigil ($match, $flags);
+ next unless (defined $match);
+
+ my $tokens = $self->_tokenize ($match);
+ my @templates = reverse @{$self->get_templates ()};
+
+ if (not @{$tokens} and not @templates)
+ {
+ return 1;
+ }
+ elsif ((@{$tokens} xor @templates) or shift @{$tokens} ne '>')
+ {
+ next;
+ }
+
+ my $do_not_care_all = 0;
+ my $do_not_care_single = 0;
+ my $template_param = '';
+ my $template_level = 0;
+ my $done = 0;
+
+ foreach my $token (@${tokens})
+ {
+ if ($done)
+ {
+ # too many tokens.
+ $done = 0;
+ last;
+ }
+ elsif ($template_level > 0)
+ {
+ $template_param = join ('', $token, $template_param);
+
+ ++$template_level if ($token eq '>');
+ --$template_level if ($token eq '<');
+ }
+ elsif ($do_not_care_all eq 1)
+ {
+ if ($token eq '<')
+ {
+ $done = 1;
+ }
+ last;
+ }
+ elsif ($do_not_care_single)
+ {
+ if ($token eq '<')
+ {
+ if (@templates == 1)
+ {
+ $done = 1;
+ }
+ last;
+ }
+ elsif ($token eq ',')
+ {
+ last unless (@templates);
+ shift (@templates);
+ $do_not_care_single = 0;
+ }
+ }
+ elsif ($token eq '!')
+ {
+ $do_not_care_all = 1;
+ }
+ elsif ($token eq '#')
+ {
+ $do_not_care_single = 1;
+ }
+ elsif ($token eq ',' or $token eq '<')
+ {
+ last unless (@templates);
+
+ my $template_details = shift (@templates);
+
+ last unless ($template_details->match_sigil ($template_param, $flags));
+ $template_param = '';
+ if ($token eq '<')
+ {
+ $done = 1;
+ }
+ }
+ else
+ {
+ ++$template_level if ($token eq '>');
+ $template_param = join ('', $token, $template_param);
+ }
+ }
+ if ($done)
+ {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub get_string ($)
+{
+ my ($self) = @_;
+ my $basic_string = $self->get_basic_string ();
+ my $result = ($basic_string ? $basic_string . ' ' : '') . $self->get_base ();
+ my $templates = $self->get_templates ();
+
+ if (@{$templates})
+ {
+ $result .= '< ';
+ foreach my $template_details (@{$templates})
+ {
+ $result .= $template_details->get_string ();
+ }
+ $result .= ' >';
+ }
+
+ return $result;
+}
+
+sub equal ($$$)
+{
+ my ($self, $other, $flags) = @_;
+
+ unless ($self->SUPER::equal ($other, $flags))
+ {
+ return 0;
+ }
+
+ if (($flags & Common::TypeDetails::Base::BASE) == Common::TypeDetails::Base::BASE)
+ {
+ my $self_base = $self->_get_base;
+ my $other_base = $self->_get_base;
+
+ if ($self_base ne $other_base)
+ {
+ return 0;
+ }
+
+ if (($flags & Common::TypeDetails::Base::RECURSIVE) == Common::TypeDetails::Base::RECURSIVE)
+ {
+ my $self_template = $self->_get_template;
+ my $other_template = $other->_get_template;
+ my $self_template_count = @{$self_template};
+ my $other_template_count = @{$other_template};
+
+ if ($self_template_count != $other_template_count)
+ {
+ return 0;
+ }
+
+ my %check = map { ($self_template->[$_]->equal ($other_template->[$_], $flags)) => undef; } 0 .. $self_template_count - 1;
+
+ if (exists $check{'0'})
+ {
+ return 0;
+ }
+ }
+
+ }
+
+ return 1;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo.pm b/tools/pm/Common/TypeInfo.pm
new file mode 100644
index 0000000..9d92bab
--- /dev/null
+++ b/tools/pm/Common/TypeInfo.pm
@@ -0,0 +1,31 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo;
+
+use strict;
+use warnings;
+
+use Common::TypeInfo::Common;
+use Common::TypeInfo::Convertors;
+use Common::TypeInfo::Global;
+use Common::TypeInfo::Local;
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Common.pm b/tools/pm/Common/TypeInfo/Common.pm
new file mode 100644
index 0000000..efa8567
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Common.pm
@@ -0,0 +1,142 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Common module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Common;
+
+use strict;
+use warnings;
+use feature ':5.10';
+use constant
+{
+ 'TRANSFER_INVALID' => -1, # do not use
+ 'TRANSFER_NONE' => 0,
+ 'TRANSFER_CONTAINER' => 1,
+ 'TRANSFER_FULL' => 2,
+ 'TRANSFER_LAST' => 3 # do not use
+};
+
+sub transfer_good_range ()
+{
+ return (TRANSFER_NONE .. TRANSFER_FULL);
+}
+
+sub transfer_from_string ($)
+{
+ my ($string) = @_;
+
+ given ($string)
+ {
+ when ('none')
+ {
+ return TRANSFER_NONE;
+ }
+ when ('container')
+ {
+ return TRANSFER_CONTAINER;
+ }
+ when ('full')
+ {
+ return TRANSFER_FULL;
+ }
+ default
+ {
+ return TRANSFER_INVALID;
+ }
+ }
+}
+
+sub transfer_to_string ($)
+{
+ my ($transfer) = @_;
+
+ given ($transfer)
+ {
+ when (TRANSFER_NONE)
+ {
+ return 'none';
+ }
+ when (TRANSFER_CONTAINER)
+ {
+ return 'container';
+ }
+ when (TRANSFER_FULL)
+ {
+ return 'full';
+ }
+ default
+ {
+ return 'invalid';
+ }
+ }
+}
+
+sub add_specific_conversion ($$$$$$)
+{
+ my ($conversions, $from, $to, $transfer_none, $transfer_container, $transfer_full) = @_;
+ unless (exists $conversions->{$from})
+ {
+ $conversions->{$from} = {};
+ }
+
+ my $from_conversions = $conversions->{$from};
+
+ unless (exists $from_conversions->{$to})
+ {
+ $from_conversions->{$to} = [$transfer_none, $transfer_container, $transfer_full];
+ }
+# TODO: what should be done with duplicates?
+}
+
+sub get_specific_conversion ($$$$$)
+{
+ my ($conversions, $from, $to, $transfer, $name) = @_;
+ my $conversion = undef;
+
+ if ($transfer > TRANSFER_INVALID and $transfer < TRANSFER_LAST)
+ {
+ if (defined $conversions and exists $conversions->{$from})
+ {
+ my $from_conversions = $conversions->{$from};
+
+ if (exists $from_conversions->{$to})
+ {
+ my $template = undef;
+
+ do
+ {
+ $template = $from_conversions->{$to}[$transfer];
+ --$transfer;
+ }
+ while (not defined $template and $transfer != TRANSFER_INVALID);
+
+ if (defined $template)
+ {
+ $template =~ s/##ARG##/$name/g;
+
+ $conversion = $template;
+ }
+ }
+ }
+ }
+
+ return $conversion;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors.pm b/tools/pm/Common/TypeInfo/Convertors.pm
new file mode 100644
index 0000000..29605ac
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors.pm
@@ -0,0 +1,35 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors;
+
+use strict;
+use warnings;
+
+use Common::TypeInfo::Convertors::Enum;
+use Common::TypeInfo::Convertors::Equal;
+use Common::TypeInfo::Convertors::Func;
+use Common::TypeInfo::Convertors::Manual;
+use Common::TypeInfo::Convertors::Normal;
+use Common::TypeInfo::Convertors::Reffed;
+use Common::TypeInfo::Convertors::StdString;
+use Common::TypeInfo::Convertors::Ustring;
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/Enum.pm b/tools/pm/Common/TypeInfo/Convertors/Enum.pm
new file mode 100644
index 0000000..d9ab92a
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/Enum.pm
@@ -0,0 +1,53 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::Enum module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::Enum;
+
+use strict;
+use warnings;
+use v5.10;
+
+sub convert ($$$$$$)
+{
+ my ($tiglobal, $from_details, $to_details, $transfer, $subst, $conversion_type) = @_;
+
+ given ($conversion_type)
+ {
+ when (Common::TypeInfo::Global::C_CXX)
+ {
+ continue;
+ }
+ when (Common::TypeInfo::Global::CXX_C)
+ {
+ if ($from_details->match_sigil (['']) and $to_details->match_sigil (['']))
+ {
+ my $to_value_details = $to_details->get_value_details ();
+
+ return join '', 'static_cast< ', $to_value_details->get_base (), ' >(', $subst, ')';
+ }
+# TODO: C pointer from/to C++ ref?
+ }
+# TODO: Container conversions?
+ }
+
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/Equal.pm b/tools/pm/Common/TypeInfo/Convertors/Equal.pm
new file mode 100644
index 0000000..1d49fb9
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/Equal.pm
@@ -0,0 +1,66 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::Equal module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::Equal;
+
+use strict;
+use warnings;
+use v5.10;
+
+sub convert ($$$$$$)
+{
+ my ($tiglobal, $from_details, $to_details, $transfer, $subst, $conversion_type) = @_;
+
+ given ($conversion_type)
+ {
+ when (Common::TypeInfo::Global::CXX_C)
+ {
+ if ($from_details->equal ($to_details, Common::TypeDetails::Base::RECURSIVE | Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ return $subst;
+ }
+ if ($from_details->equal ($to_details, Common::TypeDetails::Base::ACCESS_MODIFIERS) and $from_details->match_sigil(['&']) and $to_details->match_sigil (['*']))
+ {
+ return join '', '&(', $subst, ')';
+ }
+ }
+ when (Common::TypeInfo::Global::C_CXX)
+ {
+ if ($from_details->equal ($to_details, Common::TypeDetails::Base::RECURSIVE | Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ return $subst;
+ }
+# TODO: Correspondence C_CXX and from 'ptr' and to 'ref'
+# TODO continued: has no sense - pointer can be NULL and
+# TODO continued: reference cannot. But maybe add it if there
+# TODO continued: are some cases when we are sure that pointer
+# TODO continued: will never be NULL.
+# if ($from_details->equal ($to_details, Common::TypeDetails::Base::ACCESS_MODIFIERS) and $from_details->isa (Common::TypeDetails::Ptr) and $to_details->isa (Common::TypeDetails::Ref))
+# {
+# return join '', '*(', $subst, ')';
+# }
+ }
+# TODO: Container conversions?
+ }
+
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/Func.pm b/tools/pm/Common/TypeInfo/Convertors/Func.pm
new file mode 100644
index 0000000..80efbfe
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/Func.pm
@@ -0,0 +1,33 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::Func module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::Func;
+
+use strict;
+use warnings;
+
+sub convert ($$$$$$)
+{
+# TODO: This probably is never going to be used in type
+# TODO continued: conversions.
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/Manual.pm b/tools/pm/Common/TypeInfo/Convertors/Manual.pm
new file mode 100644
index 0000000..b7a5a27
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/Manual.pm
@@ -0,0 +1,31 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::Manual module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::Manual;
+
+use strict;
+use warnings;
+
+sub convert ($$$$$$)
+{
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/Normal.pm b/tools/pm/Common/TypeInfo/Convertors/Normal.pm
new file mode 100644
index 0000000..fdedc10
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/Normal.pm
@@ -0,0 +1,32 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::Normal module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::Normal;
+
+use strict;
+use warnings;
+
+sub convert ($$$$$$)
+{
+# TODO: Implement it.
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/Reffed.pm b/tools/pm/Common/TypeInfo/Convertors/Reffed.pm
new file mode 100644
index 0000000..470bdb0
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/Reffed.pm
@@ -0,0 +1,254 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::Reffed module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::Reffed;
+
+use strict;
+use warnings;
+use v5.10;
+
+sub convert ($$$$$$)
+{
+ my ($tiglobal, $from_details, $to_details, $transfer, $subst, $conversion_type) = @_;
+
+ given ($conversion_type)
+ {
+ when (Common::TypeInfo::Global::C_CXX ())
+ {
+ my $cxx_value_details = $to_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $cxx_templates = $cxx_value_details->get_templates ();
+
+ if (($cxx_base eq 'RefPtr' or $cxx_base eq 'Glib::RefPtr') and @{$cxx_templates} == 1)
+ {
+ if ($from_details->match_sigil (['*'], Common::TypeDetails::Base::ACCESS_MODIFIERS) and $to_details->match_sigil (['<>&', '<>', '<c>&', '<c>'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ return join ('', 'Glib::wrap(', $subst, ', ', (($transfer > Common::TypeInfo::Common::TRANSFER_NONE) ? 'true' : 'false'), ')');
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::CXX_C ())
+ {
+ my $cxx_value_details = $from_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $cxx_templates = $cxx_value_details->get_templates ();
+
+ if ($cxx_base eq 'RefPtr' or $cxx_base eq 'Glib::RefPtr' and @{$cxx_templates} == 1)
+ {
+ if ($from_details->match_sigil (['<c>&', '<c>', '<c>c&', '<c>c'], Common::TypeDetails::Base::ACCESS_MODIFIERS) and $to_details->match_sigil (['*c'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ if ($to_details->match_sigil (['*c']))
+ {
+ return join ('', 'Glib::unwrap', (($transfer > Common::TypeInfo::Common::TRANSFER_NONE) ? '' : '_copy'), '(', $subst, ')');
+ }
+ elsif ($to_details->match_sigil (['*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ my $c_value_details = $to_details->get_value_details ();
+ my $c_base = $c_value_details->get_base ();
+
+ return join ('', 'const_cast< ', $c_base, ' >(Glib::unwrap', (($transfer > Common::TypeInfo::Common::TRANSFER_NONE) ? '' : '_copy'), '(', $subst, '))');
+ }
+ }
+
+ if ($from_details->match_sigil (['<>&', '<>', '<>c&', '<>c'], Common::TypeDetails::Base::ACCESS_MODIFIERS) and $to_details->match_sigil (['*', 'c*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ return join ('', 'Glib::unwrap', (($transfer > Common::TypeInfo::Common::TRANSFER_NONE) ? '' : '_copy'), '(', $subst, ')');
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::C_CXX_CONTAINER ())
+ {
+ my $c_value_details = $from_details->get_value_details ();
+ my $c_base = $c_value_details->get_base ();
+ my $cxx_value_details = $to_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $ownership = undef;
+
+ given ($transfer)
+ {
+ when (Common::TypeInfo::Common::TRANSFER_NONE)
+ {
+ $ownership = 'Glib::OWNERSHIP_NONE';
+ }
+ when (Common::TypeInfo::Common::TRANSFER_CONTAINER)
+ {
+ $ownership = 'Glib::OWNERSHIP_SHALLOW';
+ }
+ when (Common::TypeInfo::Common::TRANSFER_FULL)
+ {
+ $ownership = 'Glib::OWNERSHIP_DEEP';
+ }
+ default
+ {
+ die;
+ }
+ }
+
+ my $cxx_value_templates = $cxx_value_details->get_templates ();
+
+ break if (@{$cxx_value_templates} != 1);
+
+ my $container_helper_template_details = $cxx_value_templates->[0];
+ my $container_helper_template_base = $container_helper_template_details->get_value_details ()->get_base ();
+
+ break if ($container_helper_template_base ne 'RefPtr' and $container_helper_template_base ne 'Glib::RefPtr');
+
+ my $container_helper_templates = $container_helper_template_details->get_string ();
+
+ given ($c_base)
+ {
+ when ('GList')
+ {
+ if ($from_details->match_sigil (['*', 'c*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil (['<<>>', '<<>>&']))
+ {
+ return join ('', '::Glib::ListHandler< ', $container_helper_templates, ' >::list_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::ListHandle Glib::ListHandle ListHandle)])
+ {
+ if ($to_details->match_sigil (['<<>>', '<<>>&']))
+ {
+ return join ('', '::Glib::ListHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ when ('GSList')
+ {
+ if ($from_details->match_sigil (['*', 'c*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil (['<<>>', '<<>>&']))
+ {
+ return join ('', '::Glib::SListHandler< ', $container_helper_templates, ' >::slist_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::SListHandle Glib::SListHandle SListHandle)])
+ {
+ if ($to_details->match_sigil (['<<>>', '<<>>&']))
+ {
+ return join ('', '::Glib::SListHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::CXX_C_CONTAINER ())
+ {
+ my $cxx_value_details = $from_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $c_value_details = $to_details->get_value_details ();
+ my $c_base = $c_value_details->get_base ();
+
+ break if ($transfer != Common::TypeInfo::Common::TRANSFER_NONE);
+
+ my $cxx_value_templates = $cxx_value_details->get_templates ();
+
+ break if (@{$cxx_value_templates} != 1);
+
+ my $container_helper_template_details = $cxx_value_templates->[0];
+ my $container_helper_template_base = $container_helper_template_details->get_value_details ()->get_base ();
+
+ break if ($container_helper_template_base ne 'RefPtr' and $container_helper_template_base ne 'Glib::RefPtr');
+
+ my $container_helper_templates = $container_helper_template_details->get_string ();
+
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($from_details->match_sigil (['<<>>', '<<>>&']))
+ {
+ given ($c_base)
+ {
+ when ('GList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', '::Glib::ListHandler< ', $container_helper_templates, ' >::vector_to_list(', $subst, ').data()');
+ }
+ }
+ when ('GSList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', '::Glib::SListHandler< ', $container_helper_templates, ' >::vector_to_slist(', $subst, ').data()');
+ }
+ }
+ default
+ {
+# TODO: check for c_type**
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::ListHandle Glib::ListHandle ListHandle)])
+ {
+ if ($from_details->match_sigil (['<<>>', '<<>>&']))
+ {
+ if ($c_base eq 'GList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::SListHandle Glib::SListHandle SListHandle)])
+ {
+ if ($from_details->match_sigil (['<<>>', '<<>>&']))
+ {
+ if ($c_base eq 'GSList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::ArrayHandle Glib::ArrayHandle ArrayHandle)])
+ {
+ if ($from_details->match_sigil (['<<>>', '<<>>&']))
+ {
+# TODO: check for c_type**.
+ }
+ }
+ }
+ }
+ }
+
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/StdString.pm b/tools/pm/Common/TypeInfo/Convertors/StdString.pm
new file mode 100644
index 0000000..ae2e9df
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/StdString.pm
@@ -0,0 +1,289 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::StdString module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::StdString;
+
+use strict;
+use warnings;
+use v5.10;
+
+sub convert ($$$$$$)
+{
+ my ($tiglobal, $from_details, $to_details, $transfer, $subst, $conversion_type) = @_;
+
+ given ($conversion_type)
+ {
+ when (Common::TypeInfo::Global::C_CXX ())
+ {
+ my $cxx_base = $to_details->get_value_details ()->get_base ();
+ my $c_base = $from_details->get_value_details ()->get_base ();
+
+ if (($cxx_base eq 'string' or $cxx_base eq 'std::string' or $cxx_base eq '::std::string') and ($c_base eq 'gchar' or $c_base eq 'char'))
+ {
+ if ($from_details->match_sigil (['*']) and $to_details->match_sigil (['', '&']))
+ {
+ if ($transfer == Common::TypeInfo::Common::TRANSFER_NONE)
+ {
+ return join ('', '::Glib::convert_const_gchar_ptr_to_stdstring(', $subst, ')');
+ }
+ else
+ {
+ return join ('', '::Glib::convert_return_gchar_ptr_to_stdstring(', $subst, ')');
+ }
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::CXX_C ())
+ {
+ my $c_base = $to_details->get_value_details ()->get_base ();
+ my $cxx_base = $from_details->get_value_details ()->get_base ();
+
+ if (($cxx_base eq 'string' or $cxx_base eq 'std::string' or $cxx_base eq '::std::string') and ($c_base eq 'gchar' or $c_base eq 'char'))
+ {
+ if ($to_details->match_sigil (['*']) and $from_details->match_sigil (['', '&']))
+ {
+ if ($transfer == Common::TypeInfo::Common::TRANSFER_NONE)
+ {
+ return join ('', '((', $subst, ').c_str())');
+ }
+ else
+ {
+ return join ('', 'g_strdup((', $subst, ').c_str())');
+ }
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::C_CXX_CONTAINER ())
+ {
+ my $c_value_details = $from_details->get_value_details ();
+ my $c_base = $c_value_details->get_base ();
+ my $cxx_value_details = $to_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $ownership = undef;
+
+ given ($transfer)
+ {
+ when (Common::TypeInfo::Common::TRANSFER_NONE)
+ {
+ $ownership = 'Glib::OWNERSHIP_NONE';
+ }
+ when (Common::TypeInfo::Common::TRANSFER_CONTAINER)
+ {
+ $ownership = 'Glib::OWNERSHIP_SHALLOW';
+ }
+ when (Common::TypeInfo::Common::TRANSFER_FULL)
+ {
+ $ownership = 'Glib::OWNERSHIP_DEEP';
+ }
+ default
+ {
+ die;
+ }
+ }
+
+ my $cxx_value_templates = $cxx_value_details->get_templates ();
+
+ break if (@{$cxx_value_templates} != 1);
+
+ my $container_helper_template_details = $cxx_value_templates->[0];
+ my $container_helper_template_base = $container_helper_template_details->get_value_details ()->get_base ();
+
+ break unless ($container_helper_template_base eq 'string' or
+ $container_helper_template_base eq 'std::string' or
+ $container_helper_template_base eq '::std::string');
+
+ my $container_helper_templates = $container_helper_template_details->get_string ();
+ my $wanted_cxx_sigils = [qw(<> <>&)];
+
+ given ($c_base)
+ {
+ when ('GList')
+ {
+ if ($from_details->match_sigil (['*', 'c*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ListHandler< ', $container_helper_templates, ' >::list_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::ListHandle Glib::ListHandle ListHandle)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ListHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ when ('GSList')
+ {
+ if ($from_details->match_sigil (['*', 'c*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::SListHandler< ', $container_helper_templates, ' >::slist_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::SListHandle Glib::SListHandle SListHandle)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::SListHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ when ([qw(gchar char)])
+ {
+ if ($from_details->match_sigil (['**']))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ArrayHandler< ', $container_helper_templates, ' >::array_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::ArrayHandle Glib::ArrayHandle ArrayHandle)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ArrayHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::CXX_C_CONTAINER ())
+ {
+ my $cxx_value_details = $from_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $c_value_details = $to_details->get_value_details ();
+ my $c_base = $c_value_details->get_base ();
+
+ break if ($transfer != Common::TypeInfo::Common::TRANSFER_NONE);
+
+ my $cxx_value_templates = $cxx_value_details->get_templates ();
+
+ break if (@{$cxx_value_templates} != 1);
+
+ my $container_helper_template_details = $cxx_value_templates->[0];
+ my $container_helper_template_base = $container_helper_template_details->get_value_details ()->get_base ();
+
+ break unless ($container_helper_template_base eq 'string' or
+ $container_helper_template_base eq 'std::string' or
+ $container_helper_template_base eq '::std::string');
+
+ my $container_helper_templates = $container_helper_template_details->get_string ();
+ my $wanted_cxx_sigils = [qw(<> <>&)];
+
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ given ($c_base)
+ {
+ when ('GList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', '::Glib::ListHandler< ', $container_helper_templates, ' >::vector_to_list(', $subst, ').data()');
+ }
+ }
+ when ('GSList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', '::Glib::SListHandler< ', $container_helper_templates, ' >::vector_to_slist(', $subst, ').data()');
+ }
+ }
+ when (['gchar', 'char'])
+ {
+ if ($to_details->match_sigil ('**'))
+ {
+ return join ('', '::Glib::ArrayHandler< ', $container_helper_templates, ' >::vector_to_array(', $subst, ').data()');
+ }
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::ListHandle Glib::ListHandle ListHandle)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ if ($c_base eq 'GList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::SListHandle Glib::SListHandle SListHandle)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ if ($c_base eq 'GSList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::ArrayHandle Glib::ArrayHandle ArrayHandle)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ if ($c_base eq 'gchar' or $c_base eq 'char')
+ {
+ if ($to_details->match_sigil ('**'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Convertors/Ustring.pm b/tools/pm/Common/TypeInfo/Convertors/Ustring.pm
new file mode 100644
index 0000000..10c6f0d
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Convertors/Ustring.pm
@@ -0,0 +1,289 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Convertors::Ustring module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Convertors::Ustring;
+
+use strict;
+use warnings;
+use v5.10;
+
+sub convert ($$$$$$)
+{
+ my ($tiglobal, $from_details, $to_details, $transfer, $subst, $conversion_type) = @_;
+
+ given ($conversion_type)
+ {
+ when (Common::TypeInfo::Global::C_CXX ())
+ {
+ my $cxx_base = $to_details->get_value_details ()->get_base ();
+ my $c_base = $from_details->get_value_details ()->get_base ();
+
+ if (($cxx_base eq 'ustring' or $cxx_base eq 'Glib::ustring' or $cxx_base eq '::Glib::ustring') and ($c_base eq 'gchar' or $c_base eq 'char'))
+ {
+ if ($from_details->match_sigil (['*']) and $to_details->match_sigil (['', '&']))
+ {
+ if ($transfer == Common::TypeInfo::Common::TRANSFER_NONE)
+ {
+ return join ('', '::Glib::convert_const_gchar_ptr_to_ustring(', $subst, ')');
+ }
+ else
+ {
+ return join ('', '::Glib::convert_return_gchar_ptr_to_ustring(', $subst, ')');
+ }
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::CXX_C ())
+ {
+ my $c_base = $to_details->get_value_details ()->get_base ();
+ my $cxx_base = $from_details->get_value_details ()->get_base ();
+
+ if (($cxx_base eq 'ustring' or $cxx_base eq 'Glib::ustring' or $cxx_base eq '::Glib::ustring') and ($c_base eq 'gchar' or $c_base eq 'char'))
+ {
+ if ($to_details->match_sigil (['*']) and $from_details->match_sigil (['', '&']))
+ {
+ if ($transfer == Common::TypeInfo::Common::TRANSFER_NONE)
+ {
+ return join ('', '((', $subst, ').c_str())');
+ }
+ else
+ {
+ return join ('', 'g_strdup((', $subst, ').c_str())');
+ }
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::C_CXX_CONTAINER ())
+ {
+ my $c_value_details = $from_details->get_value_details ();
+ my $c_base = $c_value_details->get_base ();
+ my $cxx_value_details = $to_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $ownership = undef;
+
+ given ($transfer)
+ {
+ when (Common::TypeInfo::Common::TRANSFER_NONE)
+ {
+ $ownership = 'Glib::OWNERSHIP_NONE';
+ }
+ when (Common::TypeInfo::Common::TRANSFER_CONTAINER)
+ {
+ $ownership = 'Glib::OWNERSHIP_SHALLOW';
+ }
+ when (Common::TypeInfo::Common::TRANSFER_FULL)
+ {
+ $ownership = 'Glib::OWNERSHIP_DEEP';
+ }
+ default
+ {
+ die;
+ }
+ }
+
+ my $cxx_value_templates = $cxx_value_details->get_templates ();
+
+ break if (@{$cxx_value_templates} != 1);
+
+ my $container_helper_template_details = $cxx_value_templates->[0];
+ my $container_helper_template_base = $container_helper_template_details->get_value_details ()->get_base ();
+
+ break unless ($container_helper_template_base eq 'ustring' or
+ $container_helper_template_base eq 'Glib::ustring' or
+ $container_helper_template_base eq '::Glib::ustring');
+
+ my $container_helper_templates = $container_helper_template_details->get_string ();
+ my $wanted_cxx_sigils = [qw(<> <>&)];
+
+ given ($c_base)
+ {
+ when ('GList')
+ {
+ if ($from_details->match_sigil (['*', 'c*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ListHandler< ', $container_helper_templates, ' >::list_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::ListHandle Glib::ListHandle ListHandle)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ListHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ when ('GSList')
+ {
+ if ($from_details->match_sigil (['*', 'c*'], Common::TypeDetails::Base::ACCESS_MODIFIERS))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::SListHandler< ', $container_helper_templates, ' >::slist_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::SListHandle Glib::SListHandle SListHandle)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::SListHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ when ([qw(gchar char)])
+ {
+ if ($from_details->match_sigil (['**']))
+ {
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ArrayHandler< ', $container_helper_templates, ' >::array_to_vector(', $subst, ', ', $ownership, ')');
+ }
+ }
+ when ([qw(::Glib::ArrayHandle Glib::ArrayHandle ArrayHandle)])
+ {
+ if ($to_details->match_sigil ($wanted_cxx_sigils))
+ {
+ return join ('', '::Glib::ArrayHandle< ', $container_helper_templates, ' >(', $subst, ', ', $ownership, ')');
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ when (Common::TypeInfo::Global::CXX_C_CONTAINER ())
+ {
+ my $cxx_value_details = $from_details->get_value_details ();
+ my $cxx_base = $cxx_value_details->get_base ();
+ my $c_value_details = $to_details->get_value_details ();
+ my $c_base = $c_value_details->get_base ();
+
+ break if ($transfer != Common::TypeInfo::Common::TRANSFER_NONE);
+
+ my $cxx_value_templates = $cxx_value_details->get_templates ();
+
+ break if (@{$cxx_value_templates} != 1);
+
+ my $container_helper_template_details = $cxx_value_templates->[0];
+ my $container_helper_template_base = $container_helper_template_details->get_value_details ()->get_base ();
+
+ break unless ($container_helper_template_base eq 'ustring' or
+ $container_helper_template_base eq 'Glib::ustring' or
+ $container_helper_template_base eq '::Glib::ustring');
+
+ my $container_helper_templates = $container_helper_template_details->get_string ();
+ my $wanted_cxx_sigils = [qw(<> <>&)];
+
+ given ($cxx_base)
+ {
+ when ([qw(::std::vector std::vector vector)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ given ($c_base)
+ {
+ when ('GList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', '::Glib::ListHandler< ', $container_helper_templates, ' >::vector_to_list(', $subst, ').data()');
+ }
+ }
+ when ('GSList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', '::Glib::SListHandler< ', $container_helper_templates, ' >::vector_to_slist(', $subst, ').data()');
+ }
+ }
+ when (['gchar', 'char'])
+ {
+ if ($to_details->match_sigil ('**'))
+ {
+ return join ('', '::Glib::ArrayHandler< ', $container_helper_templates, ' >::vector_to_array(', $subst, ').data()');
+ }
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::ListHandle Glib::ListHandle ListHandle)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ if ($c_base eq 'GList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::SListHandle Glib::SListHandle SListHandle)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ if ($c_base eq 'GSList')
+ {
+ if ($to_details->match_sigil ('*'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ when ([qw(::Glib::ArrayHandle Glib::ArrayHandle ArrayHandle)])
+ {
+ if ($from_details->match_sigil ($wanted_cxx_sigils))
+ {
+ if ($c_base eq 'gchar' or $c_base eq 'char')
+ {
+ if ($to_details->match_sigil ('**'))
+ {
+ return join ('', $subst, '.data()');
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return undef;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Global.pm b/tools/pm/Common/TypeInfo/Global.pm
new file mode 100644
index 0000000..b993aa6
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Global.pm
@@ -0,0 +1,1310 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Global module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Global;
+
+use strict;
+use warnings;
+#use feature ':5.10';
+use v5.10;
+
+use constant
+{
+# type info sources
+ FROM_FILES => 1,
+ GENERATED => 2,
+ FROM_MODULE_FILES => 3,
+# conversion types
+ C_CXX => 10,
+ CXX_C => 11,
+ C_CXX_CONTAINER => 12,
+ CXX_C_CONTAINER => 13,
+ UNKNOWN => 14
+# internal conversion types, do not use
+# SINGLE => 20,
+# C_CXX_CONTAINER_CHECK => 21,
+# CXX_C_CONTAINER_CHECK => 22,
+};
+
+use IO::File;
+
+use Common::Util;
+
+use Common::TypeDetails;
+use Common::TypeInfo::Common;
+use Common::TypeInfo::Convertors;
+
+sub _desired_order ()
+{
+ return (FROM_MODULE_FILES, GENERATED, FROM_FILES);
+}
+
+sub _type_to_string ($)
+{
+ my ($type) = @_;
+ my $name = undef;
+
+ given ($type)
+ {
+ when (C_CXX)
+ {
+ $name = 'C to C++';
+ }
+ when (CXX_C)
+ {
+ $name = "C++ to C";
+ }
+ when (C_CXX_CONTAINER)
+ {
+ $name = "C to C++ (container)";
+ }
+ when (CXX_C_CONTAINER)
+ {
+ $name = "C++ to C (container)";
+ }
+ default
+ {
+ $name = "invalid";
+ }
+ }
+
+ return $name;
+}
+
+sub _which_to_string ($)
+{
+ my ($which) = @_;
+ my $name = undef;
+
+ given ($which)
+ {
+ when (FROM_FILES)
+ {
+ $name = 'from_files';
+ }
+ when (GENERATED)
+ {
+ $name = 'generated';
+ }
+ when (FROM_MODULE_FILES)
+ {
+ $name = 'from_module_files';
+ }
+ default
+ {
+# TODO: throw internal error.
+ die;
+ }
+ }
+
+ return $name;
+}
+
+sub _get_c_container_types ($)
+{
+ my ($self) = @_;
+
+ return $self->{'c_container_types'};
+}
+
+sub _get_cxx_container_types ($)
+{
+ my ($self) = @_;
+
+ return $self->{'cxx_container_types'};
+}
+
+#sub _do_c_cxx_container_check ($$$)
+#{
+# my ($self, $c_value, $cxx_value) = @_;
+# my $cxx_value_iter = $cxx_value;
+# my $cxx_base = undef;
+# my $c_base = $c_value->get_base ();
+#
+# until (defined $cxx_base)
+# {
+# my $templates = $cxx_value_iter->get_templates ();
+#
+# if (@{$templates} == 1)
+# {
+# if ($templates->[0]->match_sigil ('', Common::TypeDetails::Base::NONE))
+# {
+# $cxx_value_iter = $templates->[0];
+# }
+# else
+# {
+# return 0;
+# }
+# }
+# elsif (@{$templates} == 0)
+# {
+# $cxx_base = $cxx_value_iter->get_base ();
+# }
+# }
+#
+# my $cxx_test = $self->c_to_cxx ($c_base);
+#
+# if (defined $cxx_test)
+# {
+# my $sub_types = Common::Shared::split_cpp_type_to_sub_types $cxx_test;
+#
+## TODO: think if there are cases that need checking
+## TODO continued: correspondence in another direction.
+# foreach my $sub_type (@{$sub_types})
+# {
+# if ($sub_type eq $cxx_base)
+# {
+# return 1;
+# }
+# }
+# }
+#
+# return 0;
+#}
+
+sub _get_cxx_pointer_types ($)
+{
+ my ($self) = @_;
+
+ return $self->{'cxx_pointer_types'};
+}
+
+#sub check_conversion_type ($$$)
+#{
+# my ($self, $from_details, $to_details) = @_;
+# my $c_container_types = $self->_get_c_container_types ();
+# my $cxx_container_types = $self->_get_cxx_container_types ();
+# my $conversion_type = SINGLE;
+# my $from_value = $from_details->get_value_details ();
+# my $to_value = $to_details->get_value_details ();
+# my $from_base = $from_value->get_base ();
+# my $to_base = $to_value->get_base ();
+# my @tuples =
+# (
+# [$from_details, $to_details, CXX_C_CONTAINER, CXX_C_CONTAINER_CHECK, $from_base, $to_base],
+# [$to_details, $from_details, C_CXX_CONTAINER, C_CXX_CONTAINER_CHECK, $to_base, $from_base]
+# );
+#
+# foreach my $tuple (@tuples)
+# {
+# my ($first_details, $second_details, $current_type, $current_check_type, $first_base, $second_base) = @{$tuple};
+# my $first_cxx_container = exists $cxx_container_types->{$first_base};
+# my $second_c_container = exists $c_container_types->{$second_base};
+#
+# if ($first_cxx_container)
+# {
+# print "$first_base is a C++ container\n";
+#
+# if ($second_c_container)
+# {
+# print "$second_base is a C container\n";
+# $conversion_type = $current_type;
+# }
+# elsif ($second_details->match_sigil (['*', '**'], Common::TypeDetails::Base::NONE))
+# {
+# $conversion_type = $current_check_type;
+# }
+# else
+# {
+# $conversion_type = UNKNOWN;
+# }
+#
+# last;
+# }
+# elsif ($second_c_container)
+# {
+## TODO: should we treat Gtk::Widget** as container type? I
+## TODO continued: guess not, just use vector.
+# $conversion_type = UNKNOWN;
+# last;
+# }
+# }
+#
+# given ($conversion_type)
+# {
+# when (C_CXX_CONTAINER_CHECK)
+# {
+# if ($self->_do_c_cxx_container_check ($from_value, $to_value))
+# {
+# $conversion_type = C_CXX_CONTAINER;
+# }
+# else
+# {
+# $conversion_type = UNKNOWN;
+# }
+# }
+# when (CXX_C_CONTAINER_CHECK)
+# {
+# if ($self->_do_c_cxx_container_check ($to_value, $from_value))
+# {
+# $conversion_type = CXX_C_CONTAINER;
+# }
+# else
+# {
+# $conversion_type = UNKNOWN;
+# }
+# }
+# when (SINGLE)
+# {
+# my $selected_from_base = undef;
+# my $selected_to_base = undef;
+# my $cxx_pointer_types = $self->_get_cxx_pointer_types ();
+#
+# if (exists ($cxx_pointer_types->{$from_base}))
+# {
+# $selected_from_base = $from_value->get_templates ()->[0]->get_value_details ()->get_base ();
+# $selected_to_base = $to_base;
+# }
+# elsif (exists ($cxx_pointer_types->{$to_base}))
+# {
+# $selected_from_base = $from_base;
+# $selected_to_base = $to_value->get_templates ()->[0]->get_value_details ()->get_base ();
+# }
+# else
+# {
+# $selected_from_base = $from_base;
+# $selected_to_base = $to_base;
+# }
+#
+# my @another_tuples =
+# (
+# [$selected_from_base, $selected_to_base, C_CXX],
+# [$selected_to_base, $selected_from_base, CXX_C]
+# );
+#
+# foreach my $tuple (@another_tuples)
+# {
+# my ($first_base, $second_base, $current_type) = @{$tuple};
+# my $cxx_test = $self->c_to_cxx ($first_base);
+#
+# if (defined $cxx_test)
+# {
+# my $sub_types = Common::Shared::split_cpp_type_to_sub_types $cxx_test;
+#
+## TODO: think if there are cases that need checking
+## TODO continued: correspondence in another direction.
+# foreach my $sub_type (@{$sub_types})
+# {
+# if ($sub_type eq $second_base)
+# {
+# $conversion_type = $current_type;
+# last;
+# }
+# }
+# }
+# }
+#
+# if ($conversion_type == SINGLE)
+# {
+# $conversion_type = UNKNOWN;
+# }
+# }
+# }
+#
+# return $conversion_type;
+#}
+
+sub _get_generated_type_infos_basename ($)
+{
+ my ($self) = @_;
+ my $mm_module = $self->_get_mm_module;
+ my $basename = join '_', 'type', 'infos', $mm_module, 'generated';
+
+ return $basename;
+}
+
+sub _get_generated_type_infos_filename ($)
+{
+ my ($self) = @_;
+ my $include_paths = $self->_get_include_paths;
+
+ unless (@{$include_paths})
+ {
+# TODO: internal error.
+ die;
+ }
+
+ my $filename = File::Spec->catfile ($include_paths->[0], $self->_get_generated_type_infos_basename ());
+
+ return $filename;
+}
+
+sub _get_specific_conversion ($$$$$$)
+{
+ my ($self, $which, $from, $to, $transfer, $subst) = @_;
+ my $conversions = $self->_get_specific_conversions ($which);
+ my $conversion = Common::TypeInfo::Common::get_specific_conversion $conversions,
+ $from,
+ $to,
+ $transfer,
+ $subst;
+
+ return $conversion;
+}
+
+sub _get_convertors ($)
+{
+ my ($self) = @_;
+
+ return $self->{'convertors'};
+}
+
+sub _get_meaningful_base ($$$)
+{
+ my ($self, $value, $option) = @_;
+ my $c_container_types = $self->_get_c_container_types ();
+ my $cxx_container_types = $self->_get_cxx_container_types ();
+ my $cxx_pointer_types = $self->_get_cxx_pointer_types ();
+ my $base = $value->get_base ();
+ my $done = 0;
+
+ until ($done)
+ {
+ if (exists ($cxx_container_types->{$base}) or
+ exists ($cxx_pointer_types->{$base}))
+ {
+ my $templates = $value->get_templates ();
+
+ if (@{$templates} > 0)
+ {
+ $value = $templates->[0]->get_value_details ();
+ $base = $value->get_base ();
+ }
+ else
+ {
+ $base = undef;
+ $done = 1;
+ }
+ }
+ else
+ {
+ if (exists ($c_container_types->{$base}))
+ {
+ my $imbue_type = $value->get_imbue_type ();
+
+ if (@{$imbue_type} > 0)
+ {
+ $base = $imbue_type->[0];
+ }
+ else
+ {
+ $base = undef;
+ }
+ }
+ $done = 1;
+ }
+ }
+
+ return $base;
+}
+
+sub _conversion_type ($$$$)
+{
+ my ($self, $from_details, $to_details, $general_direction) = @_;
+ my $conversion_type = UNKNOWN;
+ my $cxx_details = undef;
+ my $c_details = undef;
+ my $container_conversion = UNKNOWN;
+
+ if ($general_direction == C_CXX)
+ {
+ $c_details = $from_details;
+ $cxx_details = $to_details;
+ $container_conversion = C_CXX_CONTAINER;
+ }
+ elsif ($general_direction == CXX_C)
+ {
+ $c_details = $to_details;
+ $cxx_details = $from_details;
+ $container_conversion = CXX_C_CONTAINER;
+ }
+
+ if ($container_conversion != UNKNOWN)
+ {
+ my $c_value = $c_details->get_value_details ();
+ my $cxx_value = $cxx_details->get_value_details ();
+ my $c_base = $c_value->get_base ();
+ my $cxx_base = $cxx_value->get_base ();
+ my $c_container_types = $self->_get_c_container_types ();
+ my $cxx_container_types = $self->_get_cxx_container_types ();
+ my $is_a_c_container = exists ($c_container_types->{$c_base});
+ my $is_a_cxx_container = exists ($cxx_container_types->{$cxx_base});
+
+ if ($is_a_cxx_container)
+ {
+ if ($is_a_c_container or $c_details->match_sigil (['*', '**']))
+ {
+ $conversion_type = $container_conversion;
+ }
+ else
+ {
+ $conversion_type = UNKNOWN;
+ }
+ }
+ elsif ($is_a_c_container)
+ {
+# TODO: should we treat Gtk::Widget** as C++ container type? I
+# TODO continued: guess not, just use vector.
+ $conversion_type = UNKNOWN;
+ }
+ else
+ {
+ $conversion_type = $general_direction;
+ }
+ }
+
+ return $conversion_type;
+}
+
+sub _get_general_conversion ($$$$$$)
+{
+ my ($self, $which, $from, $to, $transfer, $subst) = @_;
+ my $conversions = $self->_get_general_conversions ($which);
+ my $from_c_conversions = $conversions->{'c'};
+ my $cxx_infos = $conversions->{'cxx'};
+ my $from_cxx_conversions = $cxx_infos->{'conversions'};
+ my $conversion = undef;
+ my $from_details = Common::TypeDetails::disassemble_type ($from);
+ my $to_details = Common::TypeDetails::disassemble_type ($to);
+ my $conversion_type = undef;
+ my $conversion_direction = UNKNOWN;
+
+ foreach my $tuple ([$from_details, $to_details, C_CXX, CXX_C], [$to_details, $from_details, CXX_C, C_CXX])
+ {
+ my $first_details = $tuple->[0];
+ my $second_details = $tuple->[1];
+ my $first_value = $first_details->get_value_details ();
+ my $second_value = $second_details->get_value_details ();
+ my $first_base = $self->_get_meaningful_base ($first_value);
+ my $to_conversions = undef;
+
+ next unless (defined ($first_base));
+
+ if (exists ($from_c_conversions->{$first_base}))
+ {
+ $conversion_direction = $tuple->[2];
+ $to_conversions = $from_c_conversions->{$first_base}{'conversions'};
+ }
+ elsif (exists ($from_cxx_conversions->{$first_base}))
+ {
+ $conversion_direction = $tuple->[3];
+ $to_conversions = $from_cxx_conversions->{$first_base};
+ }
+ else
+ {
+ next;
+ }
+
+ $conversion_direction = $self->_conversion_type ($from_details, $to_details, $conversion_direction);
+
+ next if ($conversion_direction == UNKNOWN);
+
+ my $second_base = $self->_get_meaningful_base ($second_value);
+
+ if (defined $second_base and exists ($to_conversions->{$second_base}))
+ {
+ my $temp_conversion_type = $to_conversions->{$second_base};
+
+ if (ref ($temp_conversion_type) eq '')
+ {
+ $conversion_type = $temp_conversion_type;
+ last;
+ }
+ }
+ }
+
+ if (defined $conversion_type)
+ {
+ my $convertors = $self->_get_convertors;
+
+ if (exists $convertors->{$conversion_type})
+ {
+ $conversion = $convertors->{$conversion_type}($from_details, $to_details, $transfer, $subst, $conversion_direction);
+ }
+ else
+ {
+# TODO: internal error
+ die join '', 'Unknown convertor type: `', $conversion_type, '\'.';
+ }
+ }
+
+ return $conversion;
+}
+
+##
+## general_conversions = { 'c' => {
+## $c_stuff => {
+## 'mapping' => $cxx_stuff,
+# TODO: that is completely wrong!
+## 'conversions' => { $cxx_stuff => $type }
+## }
+## },
+## 'cxx' => {
+## 'mappings' => { $full_cxx_stuff => $c_stuff },
+# TODO: and this too!
+## 'conversions' => { $cxx_stuff => { $c_stuff => $type }}
+## }
+## }
+##
+# TODO: This is quite long function. I wonder if it is justified.
+sub _add_info_to_general_conversions ($$$$$$$)
+{
+ my ($self, $c_stuff, $cxx_stuff, $type, $which, $apply_conversion, $apply_mapping) = @_;
+
+ if (not $apply_conversion and not $apply_mapping)
+ {
+# rather should not happen.
+ return;
+ }
+
+ my $conversions = $self->_get_general_conversions ($which);
+ my $cxx_sub_types = Common::Shared::split_cpp_type_to_sub_types $cxx_stuff;
+ my $from_c_conversions = $conversions->{'c'};
+
+ if (exists $from_c_conversions->{$c_stuff})
+ {
+ my $c_info = $from_c_conversions->{$c_stuff};
+
+ if ($apply_mapping)
+ {
+ if (not exists ($c_info->{'mapping'}) or not defined ($c_info->{'mapping'}))
+ {
+ $c_info->{'mapping'} = $cxx_stuff;
+ }
+ }
+
+ if ($apply_conversion)
+ {
+ if (exists ($c_info->{'conversions'}))
+ {
+ my $c_conversions = $c_info->{'conversions'};
+
+ foreach my $cxx_sub_stuff (@{$cxx_sub_types})
+ {
+ if (exists ($c_conversions->{$cxx_sub_stuff}))
+ {
+ my $type_or_types = $c_conversions->{$cxx_sub_stuff};
+ my $type_or_types_ref = ref ($type_or_types);
+
+ if ($type_or_types_ref eq '')
+ {
+ if ($type_or_types_ref ne $type)
+ {
+ $c_conversions->{$cxx_sub_stuff} = [$type_or_types, $type];
+ }
+ }
+ elsif ($type_or_types_ref eq 'ARRAY')
+ {
+ my $found = 0;
+
+ foreach my $previous_type (@{$type_or_types})
+ {
+ if ($previous_type eq $type)
+ {
+ $found = 1;
+ last;
+ }
+ }
+ unless ($found)
+ {
+ push @{$type_or_types}, $type;
+ }
+ }
+ else
+ {
+# TODO: internal error.
+ die;
+ }
+ }
+ else
+ {
+ $c_conversions->{$cxx_sub_stuff} = $type;
+ }
+ }
+ }
+ else
+ {
+ my %temp_conversions = map { $_ => $type } @{$cxx_sub_types};
+
+ $c_info->{'conversions'} = \%temp_conversions;
+ }
+ }
+ }
+ else
+ {
+ my $c_info = {};
+
+ if ($apply_mapping)
+ {
+ $c_info->{'mapping'} = $cxx_stuff;
+ }
+ if ($apply_conversion)
+ {
+ my %temp_conversions = map { $_ => $type } @{$cxx_sub_types};
+
+ $c_info->{'conversions'} = \%temp_conversions;
+ }
+ $from_c_conversions->{$c_stuff} = $c_info;
+ }
+
+ my $cxx_infos = $conversions->{'cxx'};
+
+ if ($apply_mapping)
+ {
+ my $cxx_mappings = $cxx_infos->{'mappings'};
+
+ if (not exists ($cxx_mappings->{$cxx_stuff}) or not defined ($cxx_mappings->{$cxx_stuff}))
+ {
+ $cxx_mappings->{$cxx_stuff} = $c_stuff;
+ }
+ }
+ if ($apply_conversion)
+ {
+ my $from_cxx_conversions = $cxx_infos->{'conversions'};
+
+ foreach my $cxx_sub_stuff (@{$cxx_sub_types})
+ {
+ if (exists $from_cxx_conversions->{$cxx_sub_stuff})
+ {
+ my $cxx_conversions = $conversions->{$cxx_sub_stuff};
+
+ if (exists ($cxx_conversions->{$c_stuff}))
+ {
+ my $type_or_types = $cxx_conversions->{$c_stuff};
+ my $type_or_types_ref = ref ($type_or_types);
+
+ if ($type_or_types_ref eq '')
+ {
+ if ($type_or_types ne $type)
+ {
+ $cxx_conversions->{$c_stuff} = [$type_or_types, $type];
+ }
+ }
+ elsif ($type_or_types_ref eq 'ARRAY')
+ {
+ my $found = 0;
+
+ foreach my $previous_type (@{$type_or_types})
+ {
+ if ($previous_type eq $type)
+ {
+ $found = 1;
+ last;
+ }
+ }
+ unless ($found)
+ {
+ push (@{$type_or_types}, $type);
+ }
+ }
+ else
+ {
+# TODO: internal error.
+ die;
+ }
+ }
+ else
+ {
+ $cxx_conversions->{$c_stuff} = $type;
+ }
+ }
+ else
+ {
+ $from_cxx_conversions->{$cxx_sub_stuff} = { $c_stuff => $type };
+ }
+ }
+ }
+}
+
+sub _get_unambiguous_tuples ($)
+{
+ my ($self) = @_;
+ my $conversions = $self->_get_general_conversions (GENERATED)->{'c'};
+ my @tuples = ();
+
+ foreach my $c_stuff (sort keys %{$conversions})
+ {
+ my $c_info = $conversions->{$c_stuff};
+
+ if (exists ($c_info->{'mapping'}) and exists ($c_info->{'conversions'}))
+ {
+ my $cxx_stuff = $c_info->{'mapping'};
+
+ if (defined ($cxx_stuff) and ref ($cxx_stuff) eq '' and exists ($c_info->{'conversions'}{$cxx_stuff}))
+ {
+ my $type = $c_info->{'conversions'}{$cxx_stuff};
+
+ if (defined $type and ref ($type) eq '')
+ {
+ push (@tuples, [$c_stuff, $cxx_stuff, $type]);
+ }
+ }
+ }
+ }
+
+ return \ tuples;
+}
+
+#sub _get_stuff_from ($$$)
+#{
+# my ($self, $stuff, $mapping_getter) = @_;
+#
+# foreach my $which (_desired_order ())
+# {
+# my $mapping = $self->$mapping_getter ($which);
+#
+# if (exists $mapping->{$stuff})
+# {
+# return $mapping->{$stuff};
+# }
+# }
+#
+# return undef;
+#}
+
+sub _get_mm_module ($)
+{
+ my ($self) = @_;
+
+ return $self->{'mm_module'};
+}
+
+sub _get_include_paths ($)
+{
+ my ($self) = @_;
+
+ return $self->{'include_paths'};
+}
+
+sub _get_read_files ($)
+{
+ my ($self) = @_;
+
+ return $self->{'read_files'};
+}
+
+#sub _get_common ($$$)
+#{
+# my ($self, $which, $what) = @_;
+# my $name = '';
+#
+# given ($which)
+# {
+# when (FROM_FILES)
+# {
+# $name = 'from_files';
+# }
+# when (GENERATED)
+# {
+# $name = 'generated';
+# }
+# default
+# {
+## TODO: throw internal error.
+# die;
+# }
+# }
+#
+# return $self->{$name}{$what};
+#}
+
+#sub _get_c_to_cxx ($$)
+#{
+# my ($self, $which) = @_;
+#
+# return $self->_get_common ($which, 'c_to_cxx');
+#}
+
+#sub _get_cxx_to_c ($$)
+#{
+# my ($self, $which) = @_;
+#
+# return $self->_get_common ($which, 'cxx_to_c');
+#}
+
+sub _get_conversions ($$)
+{
+ my ($self, $which) = @_;
+
+ return $self->{_which_to_string ($which)};
+}
+
+sub _get_specific_conversions ($$)
+{
+ my ($self, $which) = @_;
+ my $conversions = $self->_get_conversions ($which);
+
+ return $conversions->{'specific'};
+}
+
+sub _get_general_conversions ($$)
+{
+ my ($self, $which) = @_;
+ my $conversions = $self->_get_conversions ($which);
+
+ return $conversions->{'general'};
+}
+##
+## general_conversions = { 'c' => {
+## $c_stuff => {
+## 'mapping' => $cxx_stuff,
+## 'conversions' => { $cxx_stuff => $type }
+## }
+## },
+## 'cxx' => {
+## 'mappings' => { $full_cxx_stuff => $c_stuff },
+## 'conversions' => { $cxx_stuff => { $c_stuff => $type }}
+## }
+## }
+##
+# TODO: move into separate class.
+sub _create_hierarchy ()
+{
+ return
+ {
+ 'general' =>
+ {
+ 'c' => {},
+ 'cxx' =>
+ {
+ 'mappings' => {},
+ 'conversions' => {}
+ }
+ },
+ 'specific' => {}
+ };
+}
+
+sub new ($$$)
+{
+ my ($type, $mm_module, $include_paths) = @_;
+ my $class = (ref $type or $type or 'Common::TypeInfo::Global');
+ my $c_container_types =
+ {
+ 'GList' => undef,
+ 'GSList' => undef,
+ 'GArray' => undef,
+ 'GByteArray' => undef,
+ 'GHashTable' => undef
+ };
+ my $cxx_container_types =
+ {
+ 'std::vector' => undef,
+ 'vector' => undef,
+ 'Glib::ArrayHandle' => undef,
+ 'ArrayHandle' => undef,
+ 'Glib::ListHandle' => undef,
+ 'ListHandle' => undef,
+ 'Glib::SListHandle' => undef,
+ 'SListHandle' => undef
+ };
+ my $cxx_pointer_types =
+ {
+ 'Glib::RefPtr' => undef,
+ 'RefPtr' => undef
+ };
+ my $self =
+ {
+# 'generated' => $generated,
+# 'from_files' => $from_files,
+ 'mm_module' => $mm_module,
+ 'include_paths' => $include_paths,
+ 'read_files' => {},
+ 'c_container_types' => $c_container_types,
+ 'cxx_container_types' => $cxx_container_types,
+ 'cxx_pointer_types' => $cxx_pointer_types
+ };
+ map { $self->{ _which_to_string ($_)} = _create_hierarchy (); } (_desired_order ());
+
+ $self = bless ($self, $class);
+
+ my $convertors =
+ {
+ 'ENUM' => sub { Common::TypeInfo::Convertors::Enum::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); },
+ 'EQUAL' => sub { Common::TypeInfo::Convertors::Equal::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); },
+ 'FUNC' => sub { Common::TypeInfo::Convertors::Func::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); },
+ 'MANUAL' => sub { Common::TypeInfo::Convertors::Manual::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); },
+ 'NORMAL' => sub { Common::TypeInfo::Convertors::Normal::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); },
+ 'REFFED' => sub { Common::TypeInfo::Convertors::Reffed::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); },
+ 'STDSTRING' => sub { Common::TypeInfo::Convertors::StdString::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); },
+ 'USTRING' => sub { Common::TypeInfo::Convertors::Ustring::convert ($self, $_[0], $_[1], $_[2], $_[3], $_[4]); }
+ };
+
+ $self->{'convertors'} = $convertors;
+
+ return $self;
+}
+
+sub register_convertor ($$$)
+{
+ my ($self, $conversion_type, $convertor) = @_;
+ my $convertors = $self->_get_convertors;
+
+ if (exists $convertors->{$conversion_type})
+ {
+ die;
+ }
+ $convertors->{$conversion_type} = $convertor;
+}
+
+sub add_generated_info ($$$$)
+{
+ my ($self, $c_stuff, $cxx_stuff, $type) = @_;
+ my $apply_conversion = 1;
+ my $apply_mapping = 1;
+
+ $self->_add_info_to_general_conversions ($c_stuff, $cxx_stuff, $type, GENERATED, $apply_conversion, $apply_mapping);
+}
+
+sub c_to_cxx ($$)
+{
+ my ($self, $c_stuff) = @_;
+
+ foreach my $which (_desired_order ())
+ {
+ my $from_c_conversions = $self->_get_general_conversions ($which)->{'c'};
+
+ if (exists ($from_c_conversions->{$c_stuff}))
+ {
+ my $c_info = $from_c_conversions->{$c_stuff};
+
+ if (exists $c_info->{'mapping'})
+ {
+ my $mapping = $c_info->{'mapping'};
+
+ if (defined ($mapping))
+ {
+ return $mapping;
+ }
+ }
+ }
+ }
+
+ return undef;
+}
+
+sub cxx_to_c ($$)
+{
+ my ($self, $cxx_stuff) = @_;
+
+ foreach my $which (_desired_order ())
+ {
+ my $cxx_mappings = $self->_get_general_conversions ($which)->{'cxx'}{'mappings'};
+
+ if (exists ($cxx_mappings->{$cxx_stuff}))
+ {
+ my $mapping = $cxx_mappings->{$cxx_stuff};
+
+ if (defined ($mapping))
+ {
+ return $mapping;
+ }
+ }
+ }
+
+ return undef;
+}
+
+sub get_conversion ($$$$$)
+{
+ my ($self, $from, $to, $transfer, $subst) = @_;
+
+ foreach my $type (_desired_order ())
+ {
+ foreach my $method (\&_get_specific_conversion, \&_get_general_conversion)
+ {
+ my $conversion = $self->$method ($type,
+ $from,
+ $to,
+ $transfer,
+ $subst);
+
+ if (defined $conversion)
+ {
+ return $conversion;
+ }
+ }
+ }
+
+# TODO: throw proper exception
+ die join '', 'Could not find any conversion from `', $from, '\' to `', $to, '\' with transfer `', (Common::TypeInfo::Common::transfer_to_string $transfer), '\'';
+ return undef;
+}
+
+sub add_infos_from_file ($$)
+{
+ my ($self, $basename) = @_;
+ my $generated_type_infos_filename = $self->_get_generated_type_infos_basename;
+
+ # Do not even try to look for file that is going to be generated
+ # at the end. Yeah, we make such basename reserved.
+ if ($basename ne $generated_type_infos_filename)
+ {
+ my $include_paths = $self->_get_include_paths;
+ my $read_files = $self->_get_read_files;
+ my $found = 0;
+ my $target = FROM_MODULE_FILES;
+
+ foreach my $path (@{$include_paths})
+ {
+ my $inc_filename = File::Spec->catfile ($path, $basename);
+
+ if (-f $inc_filename and -r $inc_filename)
+ {
+ $found = 1;
+
+ unless (exists $read_files->{$inc_filename})
+ {
+ my $fd = IO::File->new ($inc_filename, 'r');
+
+ $read_files->{$inc_filename} = undef;
+ unless (defined $fd)
+ {
+# TODO: throw an error
+ die 'Could not open file `' . $inc_filename . '\' for reading.' . "\n";
+ }
+
+ my @lines = $fd->getlines;
+ my $line_num = 0;
+ my $from = undef;
+ my $to = undef;
+ my $transfers = [undef, undef, undef];
+ my $expect_brace = 0;
+
+ $fd->close;
+ foreach my $line (@lines)
+ {
+ ++$line_num;
+ $line =~ s/^\s*#.*//;
+ $line = Common::Util::string_trim $line;
+
+ next if (not defined $line or $line eq '');
+
+ if ($expect_brace)
+ {
+ if ($line ne '{')
+ {
+# TODO: parsing error - expected opening brace only in line.
+ die;
+ }
+ $expect_brace = 0;
+ }
+ elsif (defined $from and defined $to)
+ {
+ if ($line =~ /^\s*(\w+)\s*:\s*(.*)$/)
+ {
+ my $transfer_str = $1;
+ my $transfer = $2;
+ my $index = Common::TypeInfo::Common::transfer_from_string $transfer_str;
+
+# TODO: parsing error - wrong transfer name.
+ die if ($index == Common::TypeInfo::Common::TRANSFER_INVALID);
+ if (defined $transfers->[$index])
+ {
+# TODO: parsing error - that transfer is already defined.
+ die;
+ }
+
+ $transfers->[$index] = $transfer;
+ }
+ elsif ($line eq '}')
+ {
+ my $added = 0;
+
+ foreach my $transfer_type (Common::TypeInfo::Common::transfer_good_range)
+ {
+ if (defined $transfers->[$transfer_type])
+ {
+ my $conversions = $self->_get_specific_conversions ($target);
+
+ $added = 1;
+ Common::TypeInfo::Common::add_specific_conversion ($conversions,
+ $from,
+ $to,
+ $transfers->[Common::TypeInfo::Common::TRANSFER_NONE],
+ $transfers->[Common::TypeInfo::Common::TRANSFER_CONTAINER],
+ $transfers->[Common::TypeInfo::Common::TRANSFER_FULL]);
+ last;
+ }
+ }
+# TODO: parsing error - no transfer specified.
+ die unless $added;
+
+ $from = undef;
+ $to = undef;
+ $transfers = [undef, undef, undef];
+ }
+ }
+ elsif ($line =~ /^(.+?)\s*=>\s*(.+):$/)
+ {
+ $from = $1;
+ $to = $2;
+ $expect_brace = 1;
+ }
+ elsif ($line =~ /^(.+?)\s*<=>\s*(.+?)\s*##\s*(.+?)$/)
+ {
+ my $c_stuff = $1;
+ my $cxx_stuff = $2;
+ my $type = $3;
+ my $apply_conversion = 1;
+ my $apply_mapping = 1;
+
+ $self->_add_info_to_general_conversions ($c_stuff,
+ $cxx_stuff,
+ $type,
+ $target,
+ $apply_conversion,
+ $apply_mapping);
+ }
+ elsif ($line =~ /^(.+?)\s*<!>\s*(.+?)\s*##\s*(.+?)$/)
+ {
+ my $c_stuff = $1;
+ my $cxx_stuff = $2;
+ my $type = $3;
+ my $apply_conversion = 1;
+ my $do_not_apply_mapping = 0;
+
+ $self->_add_info_to_general_conversions ($c_stuff,
+ $cxx_stuff,
+ $type,
+ $target,
+ $apply_conversion,
+ $do_not_apply_mapping);
+ }
+ elsif ($line =~ /^(.+?)\s*<=>\s*(.+?)$/)
+ {
+ my $c_stuff = $1;
+ my $cxx_stuff = $2;
+ my $do_not_apply_conversion = 0;
+ my $apply_mapping = 1;
+
+ $self->_add_info_to_general_conversions ($c_stuff,
+ $cxx_stuff,
+ undef,
+ $target,
+ $do_not_apply_conversion,
+ $apply_mapping);
+ }
+ elsif ($line =~ /^include\s+(\S+)$/)
+ {
+ my $inc_basename = $1;
+
+ $self->add_infos_from_file ($inc_basename);
+ }
+ else
+ {
+# TODO: do proper logging.
+ }
+ }
+ }
+ last;
+ }
+ $target = FROM_FILES;
+ }
+ unless ($found)
+ {
+# TODO: throw an error.
+ my $message = 'Could not find `' . $basename . "' in following paths:\n";
+ foreach my $inc (@{$include_paths})
+ {
+ $message .= "$inc\n";
+ }
+ die $message;
+ }
+ }
+}
+
+sub write_generated_infos_to_file ($)
+{
+ my ($self) = @_;
+ my $filename = $self->_get_generated_type_infos_filename;
+ my $fd = IO::File->new ($filename, 'w');
+
+ unless (defined $fd)
+ {
+# TODO: do proper logging.
+ print STDERR 'Could not open file `' . $filename . '\' for writing.' . "\n";
+ exit 1;
+ }
+
+ $fd->print (join "\n",
+ '# $(C stuff) <=> $(C++ stuff) ## $(conversion type)',
+ '# LIKE: GtkWidget <=> Gtk::Widget ## NORMAL',
+ '# OR',
+ '# $(C stuff) <=> $(C++ stuff)',
+ '# LIKE: GFileAttributeInfo <=> Gio::FileAttributeInfo',
+ '# OR',
+ '# $(from) => $(to):',
+ '# {',
+ '# none: $(none conversion)',
+ '# container: $(container conversion)',
+ '# full: $(full conversion)',
+ '# }',
+ '# LIKE: const Glib::RefPtr< Gio::Emblem > => GEmblem*:',
+ '# {',
+ '# none: Glib::unwrap(##ARG##)',
+ '# full: Glib::unwrap_copy(##ARG##)',
+ '# }',
+ '# all of none, container and full are optional, but at least one of them must be',
+ '# specified',
+ '#',
+ '');
+
+ my $c_cxx_tuples = $self->_get_unambiguous_tuples;
+
+ foreach my $tuple (@{$c_cxx_tuples})
+ {
+ my $c_stuff = $tuple->[0];
+ my $cxx_stuff = $tuple->[1];
+ my $type = $tuple->[2];
+
+ $fd->print (join '', $c_stuff, ' <=> ', $cxx_stuff, ' ## ', $type, "\n");
+ }
+
+ my $conversions = $self->_get_specific_conversions (GENERATED);
+
+ foreach my $from (sort keys %{$conversions})
+ {
+ my $to_convs = $conversions->{$from};
+
+ foreach my $to (sort keys %{$to_convs})
+ {
+ my $transfers = $to_convs->{$to};
+
+ $fd->print (join '', $from, ' => ', $to, ':', "\n", '{', "\n");
+
+ foreach my $transfer_type (Common::TypeInfo::Common::transfer_good_range)
+ {
+ my $transfer = $transfers->[$transfer_type];
+
+ if (defined $transfer)
+ {
+ $fd->print (join '', ' ', (Common::TypeInfo::Common::transfer_to_string $transfer_type), ': ', $transfer, "\n");
+ }
+ }
+
+ $fd->print (join '', '}', "\n\n");
+ }
+ }
+
+ $fd->close;
+}
+
+1; # indicate proper module load.
diff --git a/tools/pm/Common/TypeInfo/Local.pm b/tools/pm/Common/TypeInfo/Local.pm
new file mode 100644
index 0000000..5156be1
--- /dev/null
+++ b/tools/pm/Common/TypeInfo/Local.pm
@@ -0,0 +1,94 @@
+# -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
+# gmmproc - Common::TypeInfo::Local module
+#
+# Copyright 2012 glibmm development team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+#
+
+package Common::TypeInfo::Local;
+
+use strict;
+use warnings;
+
+sub _get_conversions ($)
+{
+ my ($self) = @_;
+
+ return $self->{'conversions'};
+}
+
+sub _get_global ($)
+{
+ my ($self) = @_;
+
+ return $self->{'global'};
+}
+
+sub new ($$)
+{
+ my ($type, $global) = @_;
+ my $class = (ref $type or $type or 'Common::TypeInfo::Local');
+ my $self =
+ {
+ 'conversions' => {},
+ 'global' => $global
+ };
+
+ return bless $self, $class;
+}
+
+sub add_conversion ($$$$$$)
+{
+ my ($self, $from, $to, $transfer_none, $transfer_container, $transfer_full) = @_;
+ my $conversions = $self->_get_conversions;
+
+ Common::TypeInfo::Common::add_specific_conversion $conversions, $from, $to, $transfer_none, $transfer_container, $transfer_full;
+}
+
+sub get_conversion ($$$$$)
+{
+ my ($self, $from, $to, $transfer, $subst) = @_;
+ my $conversions = $self->_get_conversions;
+ my $conversion = Common::TypeInfo::Common::get_specific_conversion $conversions, $from, $to, $transfer, $subst;
+
+ unless (defined $conversion)
+ {
+ my $global = $self->_get_global;
+
+ # this will throw an exception when nothing is found.
+ $conversion = $global->get_conversion ($from, $to, $transfer, $subst);
+ }
+
+ return $conversion;
+}
+
+sub c_to_cxx ($$)
+{
+ my ($self, $c_stuff) = @_;
+ my $global = $self->_get_global;
+
+ $global->c_to_cxx ($c_stuff);
+}
+
+sub cxx_to_c ($$)
+{
+ my ($self, $cxx_stuff) = @_;
+ my $global = $self->_get_global;
+
+ $global->cxx_to_c ($cxx_stuff);
+}
+
+1; # indicate proper module load.
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
