[perl-Glib] Glib::GenPod: supply default namespace blurbs

[Torsten Schönfeld <tsch src gnome org>]

commit 1f85a852ea4301034cf951d37a8323ce52f38691
Author: Ryan Niebur <ryan debian org>
Date:   Sun Dec 6 14:39:51 2015 +0100

    Glib::GenPod: supply default namespace blurbs
    
    Namespace blurbs end up in the NAME section of POD and man pages.  In man
    pages, they are thus used by 'whatis'.
    
    If no blurb is specified for a namespace, try to figure out
    which ctype corresponds to that (using regexps), check if they really
    do (using the Glib::Type register stuff), and if they do add a whatis
    that says "wrapper for $ctype".
    
    https://bugzilla.gnome.org/show_bug.cgi?id=753468

 lib/Glib/GenPod.pm |   25 ++++++++++++++++++++++++-
 1 files changed, 24 insertions(+), 1 deletions(-)
---
diff --git a/lib/Glib/GenPod.pm b/lib/Glib/GenPod.pm
index 734e352..6e8c733 100644
--- a/lib/Glib/GenPod.pm
+++ b/lib/Glib/GenPod.pm
@@ -278,7 +278,14 @@ sub xsdoc2pod
                # end.  But all the other =head1 below need a closing =cut.
 
                print "=head1 NAME\n\n$package";
-               print ' - '.$pkgdata->{blurb} if (exists ($pkgdata->{blurb}));
+               if (exists ($pkgdata->{blurb})) {
+                       print ' - '.$pkgdata->{blurb};
+               } else {
+                       my $cname = convert_to_cname ($package);
+                       if (defined $cname) {
+                               print " - wrapper for $cname";
+                       }
+               }
                print "\n\n=cut\n\n";
 
                #                   pods            , position 
@@ -1524,6 +1531,22 @@ sub mkdir_p {
        } while (@dirs);
 }
 
+sub convert_to_cname {
+       my $perlname = shift;
+       my $cname = $perlname;
+       $cname =~ s/^Gtk2::Gdk::/Gdk/;
+       $cname =~ s/^Gtk2::/Gtk/;
+       $cname =~ s/^Gnome2::Bonobo::/Bonobo/;
+       $cname =~ s/^Gnome2::/Gnome/;
+       $cname =~ s/:://g;
+       my $tmp;
+       eval { $tmp = Glib::Type->package_from_cname($cname); };
+       if ($@ || $tmp ne $perlname) {
+               return;
+       }
+       return $cname;
+}
+
 1;
 __END__