File: methodlookup_check.pl

package info (click to toggle)
libapache2-mod-perl2 2.0.9~1624218-2%2Bdeb8u2
  • links: PTS, VCS
  • area: main
  • in suites: jessie
  • size: 11,912 kB
  • ctags: 4,588
  • sloc: perl: 95,064; ansic: 14,527; makefile: 49; sh: 18
file content (36 lines) | stat: -rwxr-xr-x 1,108 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
#!/usr/bin/perl
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-

# this script checks whether all XS methods are known to ModPerl::MethodLookup

use strict;
use warnings;

use lib "lib";

use ModPerl::MethodLookup;

# methods/classes ModPerl::MethodLookup knows about
my %known = ();
for (ModPerl::MethodLookup::avail_methods()) {
    my ($modules_hint, @modules) = ModPerl::MethodLookup::lookup_method($_);
    $known{$_} = { map {$_ => 1} @modules};
}

# real XS methods
my %real = ();
my $in = qx{grep -Ir newXS WrapXS};
while ($in =~ m{WrapXS/(\w+)/(\w+)/.*?newXS\("(?:.+)::(.+)"}g) {
    $real{$3}{"$1\::$2"}++;
}

# now check what's missing
my @miss = ();
for my $method (sort keys %real) {
    for my $module (sort keys %{ $real{$method} }) {
        #printf "%-25s %s\n", $method, $module unless $known{$method}{$module};
        push @miss, sprintf "%-25s %s\n", $module, $method unless $known{$method}{$module};
    }
}

print @miss ? sort(@miss) : "All methods are known by ModPerl::MethodLookup\n";