[glibmm/gmmproc-refactor] Move parsing gir files into Gmmproc.



commit 66eb13462bb7baa85394237e31b6caa7ab357ea1
Author: Krzesimir Nowak <qdlacz gmail com>
Date:   Mon Jul 9 22:06:28 2012 +0200

    Move parsing gir files into Gmmproc.
    
    Scanner deduces which modules have to be parsed.

 tools/gmmproc.in               |   63 ++++--------
 tools/pm/Common/Gmmproc.pm     |  230 +++++++++++++++++-----------------------
 tools/pm/Common/Scanner.pm     |   26 +++++-
 tools/pm/Common/TokensStore.pm |   17 +++-
 tools/pm/Common/WrapParser.pm  |   32 ++++--
 tools/pm/Gir/Parser.pm         |    2 +-
 tools/pm/Gir/Repositories.pm   |    4 +-
 7 files changed, 184 insertions(+), 190 deletions(-)
---
diff --git a/tools/gmmproc.in b/tools/gmmproc.in
index 44130f6..d87e006 100644
--- a/tools/gmmproc.in
+++ b/tools/gmmproc.in
@@ -30,12 +30,11 @@
 
 use strict;
 use warnings;
+use v5.12;
 use IO::File;
 use Getopt::Long qw(:config permute);
 
-require Gir::Parser;
-require Gir::Repositories;
-require Common::Gmmproc;
+use Common::Gmmproc;
 
 # prototypes
 sub print_usage ();
@@ -113,30 +112,25 @@ sub main ()
   my $source_dir = undef;
   my $destination_dir = undef;
   my $unwrapped = 0;
-  my $gir_basename = undef;
   my $templates = [];
   my $include_paths = [];
   my $debug = (exists $ENV{'GMMPROC_DEBUG'}) ? $ENV{'GMMPROC_DEBUG'} : 0;
   my $mm_module = undef;
   my $wrap_init_namespace = undef;
-  my $opt_parse_result = GetOptions
-  (
-    'help|h' => \&print_help,
-    'source|s=s' => \$source_dir,
-    'destination|d=s' => \$destination_dir,
-    'list|l=s' => sub { process_list_file ($templates, shift, shift) },
-    'unwrapped|u' => \$unwrapped,
-    'gir|r=s' => \$gir_basename,
-    'include|i=s@' => \$include_paths,
-    'debug|g' => \$debug,
-    'mm-module|m=s' => \$mm_module,
-    'wrap-init-namespace|w=s' => \$wrap_init_namespace,
-    '<>' => sub { add_file_to_list ($templates, shift); }
-  );
+  my $opt_parse_result = GetOptions ('help|h' => \&print_help,
+                                     'source|s=s' => \$source_dir,
+                                     'destination|d=s' => \$destination_dir,
+                                     'list|l=s' => sub { process_list_file ($templates, shift, shift) },
+                                     'unwrapped|u' => \$unwrapped,
+                                     'include|i=s@' => \$include_paths,
+                                     'debug|g' => \$debug,
+                                     'mm-module|m=s' => \$mm_module,
+                                     'wrap-init-namespace|w=s' => \$wrap_init_namespace,
+                                     '<>' => sub { push (@{$templates}, $_[0]); });
 
 # TODO: print what is wrong.
   if (not $opt_parse_result or not $source_dir or not $destination_dir or
-      not $mm_module or @{$templates} < 1 or not $gir_basename or
+      not $mm_module or @{$templates} < 1 or
       @{$include_paths} < 1 or not $wrap_init_namespace)
   {
     print_usage;
@@ -145,23 +139,14 @@ sub main ()
 
   eval
   {
-    my $gir_parser = Gir::Parser->new;
+    my $gmmproc = Common::Gmmproc->new ($mm_module,
+                                        $include_paths,
+                                        $wrap_init_namespace,
+                                        $source_dir,
+                                        $destination_dir,
+                                        $templates);
 
-    $gir_parser->parse_file ($gir_basename);
-
-    my $repositories = $gir_parser->get_repositories;
-    my $gmmproc = Common::Gmmproc->new ($repositories, $mm_module, $include_paths, $wrap_init_namespace);
-
-# TODO: move it to constructor.
-    $gmmproc->set_source_dir ($source_dir);
-    $gmmproc->set_destination_dir ($destination_dir);
-
-    for my $template (@{$templates})
-    {
-      $gmmproc->add_base ($template);
-    }
-
-    $gmmproc->parse_and_generate;
+    $gmmproc->parse_and_generate ();
 
 # TODO: info about unwrapped information should be written to a logfile.
     if ($unwrapped)
@@ -206,11 +191,3 @@ sub process_list_file ($$$)
     }
   }
 }
-
-sub add_file_to_list ($$)
-{
-  my $templates = shift;
-  my $file = shift;
-
-  push @{$templates}, $file;
-}
diff --git a/tools/pm/Common/Gmmproc.pm b/tools/pm/Common/Gmmproc.pm
index 90b177e..07f3cc7 100644
--- a/tools/pm/Common/Gmmproc.pm
+++ b/tools/pm/Common/Gmmproc.pm
@@ -33,9 +33,10 @@ use Common::TypeInfo::Global;
 use Common::WrapParser;
 use Common::Variables;
 
+use Gir::Parser;
 use Gir::Repositories;
 
-sub _tokenize_contents_ ($)
+sub _tokenize_contents_
 {
   my ($contents) = @_;
   # Break the file into tokens.  Token is:
@@ -56,19 +57,75 @@ sub _tokenize_contents_ ($)
   return \ tokens;
 }
 
-sub _prepare ($)
+sub _get_source_dir
 {
   my ($self) = @_;
-  my $type_info_global = $self->get_type_info_global;
+
+  return $self->{'source_dir'};
+}
+
+sub _get_destination_dir
+{
+  my ($self) = @_;
+
+  return $self->{'destination_dir'};
+}
+
+sub _get_bases
+{
+  my ($self) = @_;
+
+  return $self->{'bases'};
+}
+
+sub _get_repositories
+{
+  my ($self) = @_;
+
+  return $self->{'repositories'};
+}
+
+sub _set_repositories
+{
+  my ($self, $repositories) = @_;
+
+  $self->{'repositories'} = $repositories;
+}
+
+sub _get_type_info_global
+{
+  my ($self) = @_;
+
+  return $self->{'type_info_global'};
+}
+
+sub _get_mm_module
+{
+  my ($self) = @_;
+
+  return $self->{'mm_module'};
+}
+
+sub _get_wrap_init_namespace
+{
+  my ($self) = @_;
+
+  return $self->{'wrap_init_namespace'};
+}
+
+sub _prepare
+{
+  my ($self) = @_;
+  my $type_info_global = $self->_get_type_info_global ();
 
   $type_info_global->add_infos_from_file ('type_infos');
 }
 
-sub _read_all_bases ($)
+sub _read_all_bases
 {
   my ($self) = @_;
-  my $source_dir = $self->get_source_dir;
-  my $bases = $self->get_bases;
+  my $source_dir = $self->_get_source_dir ();
+  my $bases = $self->_get_bases ();
 
   # parallelize
   foreach my $base (sort keys %{$bases})
@@ -106,10 +163,10 @@ sub _read_all_bases ($)
   }
 }
 
-sub _scan_all_bases ($)
+sub _scan_all_bases
 {
   my ($self) = @_;
-  my $bases = $self->get_bases;
+  my $bases = $self->_get_bases;
   my @bases_keys = sort keys %{$bases};
 
   # parallelize
@@ -122,33 +179,36 @@ sub _scan_all_bases ($)
 
     $scanner->scan;
     $tokens_store->set_tuples ($scanner->get_tuples);
+    $tokens_store->set_modules ($scanner->get_modules);
   }
 
-  my $type_info_global = $self->get_type_info_global;
+  my $type_info_global = $self->_get_type_info_global;
+  my %gir_modules = ();
 
   foreach my $base (@bases_keys)
   {
     my $tokens_store = $bases->{$base};
-    my $tuples = $tokens_store->get_tuples;
-
-    foreach my $tuple (@{$tuples})
-    {
-      my $c_stuff = $tuple->[0];
-      my $cxx_stuff = $tuple->[1];
-      my $macro_type = $tuple->[2];
+    my $tuples = $tokens_store->get_tuples ();
+    my $modules = $tokens_store->get_modules ();
 
-      $type_info_global->add_generated_info ($c_stuff, $cxx_stuff, $macro_type);
-    }
+    map { $type_info_global->add_generated_info (@{$_}); } @{$tuples};
+    map { $gir_modules{$_} = undef; } @{$modules};
   }
+
+  my $gir_parser = Gir::Parser->new ();
+
+  map { $gir_parser->parse_file ($_); } keys (%gir_modules);
+
+  $self->_set_repositories ($gir_parser->get_repositories ());
 }
 
-sub _parse_all_bases ($)
+sub _parse_all_bases
 {
   my ($self) = @_;
-  my $bases = $self->get_bases;
-  my $type_info_global = $self->get_type_info_global ();
-  my $repositories = $self->get_repositories;
-  my $mm_module = $self->get_mm_module;
+  my $bases = $self->_get_bases;
+  my $type_info_global = $self->_get_type_info_global ();
+  my $repositories = $self->_get_repositories;
+  my $mm_module = $self->_get_mm_module;
 
   # parallelize
   foreach my $base (sort keys %{$bases})
@@ -172,7 +232,7 @@ sub _parse_all_bases ($)
 sub _generate_wrap_init
 {
   my ($self) = @_;
-  my $bases = $self->get_bases ();
+  my $bases = $self->_get_bases ();
   my %total_c_includes = ();
   my %total_cxx_includes = ();
   my %total_entries = ();
@@ -230,9 +290,9 @@ sub _generate_wrap_init
     }
   }
 
-  my $destination_dir = $self->get_destination_dir ();
+  my $destination_dir = $self->_get_destination_dir ();
   my $wrap_init_cc = IO::File->new ($destination_dir . '/wrap_init.cc', 'w');
-  my $mm_module = $self->get_mm_module ();
+  my $mm_module = $self->_get_mm_module ();
   my $deprecation_guard = uc ($mm_module) . '_DISABLE_DEPRECATED';
 
   die unless (defined ($wrap_init_cc));
@@ -277,7 +337,7 @@ sub _generate_wrap_init
     $wrap_init_cc->say ();
   }
 
-  my @namespaces = split (/::/, $self->get_wrap_init_namespace ());
+  my @namespaces = split (/::/, $self->_get_wrap_init_namespace ());
 
   foreach my $namespace (@namespaces)
   {
@@ -313,11 +373,11 @@ sub _generate_wrap_init
   $wrap_init_cc->close();
 }
 
-sub _generate_all_bases ($)
+sub _generate_all_bases
 {
   my ($self) = @_;
-  my $bases = $self->get_bases;
-  my $destination_dir = $self->get_destination_dir;
+  my $bases = $self->_get_bases;
+  my $destination_dir = $self->_get_destination_dir;
 
   # parallelize
   foreach my $base (sort keys %{$bases})
@@ -336,126 +396,34 @@ sub _generate_all_bases ($)
   $self->_generate_wrap_init ();
 }
 
-sub _finish ($)
+sub _finish
 {
   my ($self) = @_;
-  my $type_info_global = $self->get_type_info_global ();
+  my $type_info_global = $self->_get_type_info_global ();
 
   $type_info_global->write_generated_infos_to_file ();
 }
 
 sub new
 {
-  my ($type, $repositories, $mm_module, $include_paths, $wrap_init_namespace) = @_;
+  my ($type, $mm_module, $include_paths, $wrap_init_namespace, $source_dir, $destination_dir, $templates) = @_;
   my $class = (ref $type or $type or 'Common::Gmmproc');
+  my %bases = map { $_ => Common::TokensStore->new() } @{$templates};
   my $self =
   {
-    'repositories' => $repositories,
-    'bases' => {},
-    'source_dir' => '.',
-    'destination_dir' => '.',
+    'repositories' => undef,
+    'bases' => \%bases,
+    'source_dir' => $source_dir,
+    'destination_dir' => $destination_dir,
     'type_info_global' => Common::TypeInfo::Global->new ($mm_module, $include_paths),
     'mm_module' => $mm_module,
-    'include_paths' => $include_paths,
     'wrap_init_namespace' => $wrap_init_namespace
   };
 
   return bless $self, $class;
 }
 
-sub set_source_dir ($$)
-{
-  my ($self, $source_dir) = @_;
-
-  $self->{'source_dir'} = $source_dir;
-}
-
-sub get_source_dir ($)
-{
-  my ($self) = @_;
-
-  return $self->{'source_dir'};
-}
-
-sub set_destination_dir ($$)
-{
-  my ($self, $destination_dir) = @_;
-
-  $self->{'destination_dir'} = $destination_dir;
-}
-
-sub get_destination_dir ($)
-{
-  my ($self) = @_;
-
-  return $self->{'destination_dir'};
-}
-
-sub set_include_paths ($$)
-{
-  my ($self, $include_paths) = @_;
-
-  $self->{'include_paths'} = $include_paths;
-}
-
-sub get_include_paths ($)
-{
-  my ($self) = @_;
-
-  return $self->{'include_paths'};
-}
-
-sub add_base ($$)
-{
-  my ($self, $base) = @_;
-  my $bases = $self->get_bases;
-
-  if (exists $bases->{$base})
-  {
-# TODO: is proper logging needed at this stage?
-    print STDERR 'Base `' . $base . ' was already added.' . "\n";
-    return;
-  }
-
-  $bases->{$base} = Common::TokensStore->new;
-}
-
-sub get_bases ($)
-{
-  my ($self) = @_;
-
-  return $self->{'bases'};
-}
-
-sub get_repositories ($)
-{
-  my ($self) = @_;
-
-  return $self->{'repositories'};
-}
-
-sub get_type_info_global ($)
-{
-  my ($self) = @_;
-
-  return $self->{'type_info_global'};
-}
-
-sub get_mm_module ($)
-{
-  my ($self) = @_;
-
-  return $self->{'mm_module'};
-}
-
-sub get_wrap_init_namespace
-{
-  my ($self) = @_;
-
-  return $self->{'wrap_init_namespace'};
-}
-
-sub parse_and_generate ($)
+sub parse_and_generate
 {
   my ($self) = @_;
 
diff --git a/tools/pm/Common/Scanner.pm b/tools/pm/Common/Scanner.pm
index 3bb6d80..aa941dd 100644
--- a/tools/pm/Common/Scanner.pm
+++ b/tools/pm/Common/Scanner.pm
@@ -443,6 +443,20 @@ sub _on_class_opaque_refcounted ($)
   }
 }
 
+sub _on_module
+{
+  my ($self) = @_;
+  my @args = Common::Shared::string_split_commas ($self->_extract_bracketed_text ());
+
+  if (@args != 1)
+  {
+# TODO: warning.
+    return;
+  }
+
+  $self->{'modules'}{$args[0] . '.gir'} = undef;
+}
+
 sub _on_namespace_keyword ($)
 {
   my ($self) = @_;
@@ -588,7 +602,8 @@ sub new ($$$)
     'namespaces' => [],
     'class_levels' => [],
     'classes' => [],
-    'level' => 0
+    'level' => 0,
+    'modules' => {}
   };
 
   $self = bless $self, $class;
@@ -618,6 +633,7 @@ sub new ($$$)
     '_CLASS_INTERFACE' => sub { $self->_on_class_interface (@_); },
     '_CLASS_OPAQUE_COPYABLE' => sub { $self->_on_class_opaque_copyable (@_); },
     '_CLASS_OPAQUE_REFCOUNTED' => sub { $self->_on_class_opaque_refcounted (@_); },
+    '_MODULE' => sub { $self->_on_module (@_); },
     'namespace' => sub { $self->_on_namespace_keyword (@_); },
     'class' => sub { $self->_on_class_keyword (@_); }
   };
@@ -658,4 +674,12 @@ sub get_tuples ($)
   return $self->{'tuples'};
 }
 
+sub get_modules ($)
+{
+  my ($self) = @_;
+  my @modules = keys (%{$self->{'modules'}});
+
+  return \ modules;
+}
+
 1; # indicate proper module load.
diff --git a/tools/pm/Common/TokensStore.pm b/tools/pm/Common/TokensStore.pm
index eab2af4..0591e1d 100644
--- a/tools/pm/Common/TokensStore.pm
+++ b/tools/pm/Common/TokensStore.pm
@@ -33,7 +33,8 @@ sub new ($)
     'section_manager' => undef,
     'tokens_hg' => undef,
     'tokens_ccg' => undef,
-    'wrap_init_entries' => undef
+    'wrap_init_entries' => undef,
+    'modules' => undef
   };
 
   return bless $self, $class;
@@ -109,4 +110,18 @@ sub get_wrap_init_entries
   return $self->{'wrap_init_entries'};
 }
 
+sub set_modules
+{
+  my ($self, $modules) = @_;
+
+  $self->{'modules'} = $modules;
+}
+
+sub get_modules
+{
+  my ($self) = @_;
+
+  return $self->{'modules'};
+}
+
 1; # indicate proper module load.
diff --git a/tools/pm/Common/WrapParser.pm b/tools/pm/Common/WrapParser.pm
index 412c266..8b85df6 100644
--- a/tools/pm/Common/WrapParser.pm
+++ b/tools/pm/Common/WrapParser.pm
@@ -785,6 +785,7 @@ sub _on_wrap_method ($)
 # TODO continued: namespace is not needed.
   my $repositories = $self->get_repositories;
   my $module = $self->get_module;
+  my $module_namespace = (split (/-/, $module))[0];
   my $repository = $repositories->get_repository ($module);
 
   unless (defined $repository)
@@ -792,7 +793,7 @@ sub _on_wrap_method ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $gir_namespace = $repository->get_g_namespace_by_name ($module);
+  my $gir_namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $gir_namespace)
   {
@@ -1226,8 +1227,9 @@ sub _on_wrap_enum ($)
   my ($self) = @_;
   my $repositories = $self->get_repositories;
   my $module = $self->get_module;
+  my $module_namespace = (split (/-/, $module))[0];
   my $repository = $repositories->get_repository ($module);
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
   my @args = Common::Shared::string_split_commas ($self->_extract_bracketed_text);
 
   if (@args < 2)
@@ -1303,8 +1305,9 @@ sub _on_wrap_gerror ($)
   my ($self) = @_;
   my $repositories = $self->get_repositories;
   my $module = $self->get_module;
+  my $module_namespace = (split (/-/, $module))[0];
   my $repository = $repositories->get_repository ($module);
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
   my @args = Common::Shared::string_split_commas ($self->_extract_bracketed_text);
 
   if (@args < 2)
@@ -1427,7 +1430,8 @@ sub _on_class_generic ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $module_namespace = (split (/-/, $module))[0];
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $namespace)
   {
@@ -1500,7 +1504,8 @@ sub _on_class_g_object ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $module_namespace = (split (/-/, $module))[0];
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $namespace)
   {
@@ -1714,7 +1719,8 @@ sub _on_class_boxed_type ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $module_namespace = (split (/-/, $module))[0];
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $namespace)
   {
@@ -1886,7 +1892,8 @@ sub _on_class_boxed_type_static ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $module_namespace = (split (/-/, $module))[0];
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $namespace)
   {
@@ -1935,7 +1942,8 @@ sub _on_class_interface ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $module_namespace = (split (/-/, $module))[0];
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $namespace)
   {
@@ -2102,7 +2110,8 @@ sub _on_class_opaque_copyable ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $module_namespace = (split (/-/, $module))[0];
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $namespace)
   {
@@ -2268,7 +2277,8 @@ sub _on_class_opaque_refcounted ($)
     $self->fixed_error ('No such repository: ' . $module);
   }
 
-  my $namespace = $repository->get_g_namespace_by_name ($module);
+  my $module_namespace = (split (/-/, $module))[0];
+  my $namespace = $repository->get_g_namespace_by_name ($module_namespace);
 
   unless (defined $namespace)
   {
@@ -2590,7 +2600,7 @@ sub _on_class_keyword ($)
   $self->fixed_error ('Hit eof while processing `class\'.');
 }
 
-sub _on_module ($)
+sub _on_module
 {
   my ($self) = @_;
   my $str = Common::Util::string_trim $self->_extract_bracketed_text;
diff --git a/tools/pm/Gir/Parser.pm b/tools/pm/Gir/Parser.pm
index 015f469..bbce710 100644
--- a/tools/pm/Gir/Parser.pm
+++ b/tools/pm/Gir/Parser.pm
@@ -278,7 +278,7 @@ sub parse_file ($$)
     unless (defined $real_filename)
     {
 # TODO: throw a runtime error.
-      my $message = join '', 'Could not find ', $filename, ' in followin paths:', "\n", (join "\n", @{$girdirs}), "\n";
+      my $message = join '', 'Could not find ', $filename, ' in following paths:', "\n", (join "\n", @{$girdirs}), "\n";
       die $message; # with horrible death!
     }
 
diff --git a/tools/pm/Gir/Repositories.pm b/tools/pm/Gir/Repositories.pm
index bf84f95..4631db6 100644
--- a/tools/pm/Gir/Repositories.pm
+++ b/tools/pm/Gir/Repositories.pm
@@ -1,5 +1,5 @@
 # -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil -*-
-## Copyright 2011 Krzesimir Nowak
+## Copyright 2011, 2012 Krzesimir Nowak
 ##
 ## 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
@@ -38,7 +38,7 @@ sub add_repository ($$)
   my ($self, $repository) = @_;
   my $repositories = $self->{'repositories'};
   my $namespace = $repository->get_g_namespace_by_index (0);
-  my $name = $namespace->get_a_name ();
+  my $name = join ('-', $namespace->get_a_name (), $namespace->get_a_version ());
 
   if (exists $repositories->{$name})
   {



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]