cvs commit: modperl-2.0/util xs_check.pl

[dougm]

dougm       01/03/04 19:55:56

  Added:       util     xs_check.pl
  Log:
  script to check if things are lined up properly, whats missing, what doesnt exist, 
etc.
  
  Revision  Changes    Path
  1.1                  modperl-2.0/util/xs_check.pl
  
  Index: xs_check.pl
  ===================================================================
  use lib qw(lib);
  
  use strict;
  use warnings qw(FATAL all);
  
  use ModPerl::TypeMap ();
  use ModPerl::FunctionMap ();
  use ModPerl::StructureMap ();
  use ModPerl::WrapXS ();
  use ModPerl::MapUtil qw(disabled_reason);
  
  my %check = (
      types      => ModPerl::TypeMap->new,
      functions  => ModPerl::FunctionMap->new,
      structures => ModPerl::StructureMap->new,
  );
  
  my %missing;
  while (my($things, $obj) = each %check) {
      $missing{$things} = $obj->check;
      if (my $missing = $missing{$things}) {
          my $n = @$missing;
          print "$n $things are not mapped:\n";
          print "--> $_\n" for @$missing;
      }
      else {
          print "all $things are mapped\n";
      }
  }
  
  my %check_exists = (
      functions => $check{functions},
      structure_members => $check{structures},
      types => $check{types},
  );
  
  while (my($things, $obj) = each %check_exists) {
      if (my $missing = $obj->check_exists) {
          my $n = @$missing;
          print "$n mapped $things do not exist:\n";
          print "--> $_\n" for @$missing;
      }
      else {
          print "all mapped $things exist\n";
      }
  }
  
  my %unmapped = map { $_,1 } @{ $missing{functions} } if $missing{functions};
  my $typemap = $check{types};
  my $function_map = $check{functions};
  my @missing;
  
  for my $entry (@$Apache::FunctionTable) {
      my $func;
      my $name = $entry->{name};
      next if $unmapped{$name};
      next unless $function_map->{map}->{$name};
      next if $func = $typemap->map_function($entry);
      push @missing, $name;
  }
  
  if (@missing) {
      my $n = @missing;
      print "unable to glue $n mapped functions:\n";
      print "--> $_\n" for @missing;
  }
  else {
      print "all mapped functions are glued\n";
  }
  
  my $stats = ModPerl::WrapXS->new->stats;
  my($total_modules, $total_xsubs);
  
  while (my($module, $n) = each %$stats) {
      $total_modules++;
      $total_xsubs += $n;
  }
  
  print "$total_modules total modules, ",
            "$total_xsubs total xsubs\n";
  
  while (my($module, $n) = each %$stats) {
      print "$module: $n\n";
  }
  
  for (qw(functions structure_members)) {
      my $disabled = $check_exists{$_}->disabled;
      my $total = 0;
      for my $names (values %$disabled) {
          $total += @$names;
      }
      print "$total $_ are not wrapped:\n";
      while (my($r, $names) = each %$disabled) {
          printf "%4d are %s\n", scalar @$names, disabled_reason($r);
      }
  }
  
  if (@ARGV) {
      my $key = '!';
      for (qw(functions structure_members)) {
          my $disabled = $check_exists{$_}->disabled;
          my $names = $disabled->{$key};
          printf "%s $_:\n", disabled_reason($key);
          for my $name (sort @$names) {
              print "   $name\n";
          }
      }
  }