From c84e02b58babf893d1c63eae4a090a75902293ea Mon Sep 17 00:00:00 2001
From: Thierry Vignaud <tv@mageia.org>
Date: Mon, 30 Jan 2012 17:48:03 +0000
Subject: (parse_pm) parse .pm files too when generating fake packages

eg: URPM (or some Gtk2*) implement methods in both perl & XS
---
 NEWS                 |  2 ++
 fake_packages/gen.pl | 36 ++++++++++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+)

diff --git a/NEWS b/NEWS
index 041e49f..309a778 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,5 @@
+- parse .pm files too when generating fake packages
+
 Version 1.2.12 - 20 September 2010, by Thierry Vignaud
 
 - update fake packages
diff --git a/fake_packages/gen.pl b/fake_packages/gen.pl
index f5e336f..f65c3e6 100755
--- a/fake_packages/gen.pl
+++ b/fake_packages/gen.pl
@@ -85,12 +85,48 @@ sub parse_xs {
     }
 }
 
+sub parse_pm {
+    my ($file) = @_;
+    warn "parse_pm $file\n";
+    my $state = 'waiting_for_type';
+    my $name;
+    $current_package = '';
+    my $c;
+    foreach (cat_($file)) {
+	$c++;
+	next if /^=/ ... /^=cut/;
+	chomp;
+	my $orig_line = $_;
+
+	if (/^\s*#/ || (m!^\s*/\*! .. m!\*/!)) {
+	    # forget it
+	} elsif (/^package\s*(\S+)\s*;/) {
+	    $current_package = $1;
+	} elsif (!$current_package) {
+	    # waiting for the package line
+	} elsif (/^sub\s*(\S*)/) {
+            $name = $1;
+            $l{$current_package}{$name} = [] if !defined($l{$current_package}{$name});
+	    $state = 'waiting_for_param';
+	} elsif ($state eq 'waiting_for_param' && /=\s*\@_/) {
+            get_paras($name, $_);
+            $state = 'waiting_for_end';
+	} else {
+	    warn "bad line2 #$c $orig_line (state: $state)\n" if 0 &&
+	      !(($state eq 'waiting_for_end' || $state eq 'waiting_for_type') && 
+		(/^\s/ || /^[{}]\s*$/ || /^(CODE|OUTPUT):\s*$/));
+	}
+    }
+}
 
 my ($pkg_name, $dir) = @ARGV;
 my @xs_files = chomp_(`find $dir -name "*.xs"`);
+# ignore test suites, inc/ and ext/ :
+my @pm_files = chomp_(`find $dir -name "*.pm" | egrep -v '/(ext|inc|t)/'`);
 @ARGV == 2 && @xs_files or die "usage: gen.pl <Gtk2 or Glib> <dir where Gtk2's or Glib's *.xs are>\n";
 
 parse_xs($_) foreach @xs_files;
+parse_pm($_) foreach @pm_files;
 
 print "package $pkg_name;\nuse Glib;\n" if $pkg_name eq 'Gtk2';
 
-- 
cgit v1.2.1