view release on metacpan or  search on metacpan

parse-for-doxygen.pl  view on Meta::CPAN

use strict;
use warnings;
use Modern::Perl;

my @pm = qw(lib/Geo/GDAL.pm lib/Geo/OGR.pm lib/Geo/OSR.pm lib/Geo/GDAL/Const.pm lib/Geo/GNM.pm);

my %internal_methods = map {$_=>1} qw/TIEHASH CLEAR FIRSTKEY NEXTKEY FETCH STORE
                                      DESTROY DISOWN ACQUIRE RELEASE_PARENTS
                                      UseExceptions DontUseExceptions this AllRegister RegisterAll
                                      callback_d_cp_vp/;
my %private_methods = map {$_=>1} qw/PushErrorHandler PopErrorHandler Error ErrorReset
                                     GetLastErrorNo GetLastErrorType GetLastErrorMsg/;
my %constant_prefixes = map {$_=>1} qw/DCAP_/;

my %package;
my $package;
my $sub;
my $attr;
for my $pm (@pm) {
    open(my $fh, "<", $pm) or die "cannot open < $pm: $!";
    while (<$fh>) {
        chomp;
        my $code = $_;
        s/^\s+//;
        next if $_ eq '';
        next if $_ =~ /^#####/; # skip swig comments
        my($w) = /^(\S+)\s/;
        $w //= '';
        if ($w eq 'package') {
            $package = $_;
            $package =~ s/^(\S+)\s+//;
            $package =~ s/;.*//;
            $sub = '';
            $attr = '';
            next;
        }
        if ($w eq 'sub') {
            $sub = $_;
            $sub =~ s/^(\S+)\s+//;
            $sub =~ s/\W.*//;
            next if $sub eq ''; # skip anonymous subs
            $package{$package}{subs}{$sub} = 1;
            $attr = '';
            next;
        }
        if ($w =~ /^\*/) {
            $sub = $w;
            $sub =~ s/^\*//;
            $sub =~ s/\W.*//;
            $package{$package}{subs}{$sub} = 1;
            $attr = '';
            next;
        }
        if (!$sub and $w =~ /^[\$@\%]/ and /=/) {
            $attr = $w;
            $attr =~ s/^[\$@\%]//;
            $attr =~ s/\W.*//;
            #print "attr: $attr\n";
            $package{$package}{attr}{$attr} = 1;
            $sub = '';
        }
        if (/use base/) {
            #print "$_\n";