New script to find messages to explein in documentation

This commit is contained in:
Xavier Guimard 2010-10-02 08:33:33 +00:00
parent d745debde9
commit 1fa1f29329

View File

@ -0,0 +1,55 @@
#!/usr/bin/perl
use strict;
my $errorMsg;
foreach my $module (qw(common handler manager portal)) {
open CMD,
"find lemonldap-ng-$module/lib/Lemonldap/NG -type f -name '*.pm'|";
my @files;
while (<CMD>) {
chomp;
push @files, $_;
}
close CMD;
# my @files = qw(lemonldap-ng-portal/lib/Lemonldap/NG/Portal/AuthChoice.pm);
foreach my $file (@files) {
open F, $file;
$file =~ s#.*/NG/##;
my $autoload = 0;
while (<F>) {
next if /^(?:\s*#|\*lmLog|sub lmLog)/;
$autoload = 1 if (/use\s+AutoLoader/);
last if ( /^__END__$/ and not $autoload );
next unless (/lmLog|STDERR/);
if (/lmLog/) {
$_ .= <F> while ( !/[\)\}];/s );
}
else {
$_ .= <F> while ( !/(?:\s+if\s*\()?;$/ );
}
$_ =~ s/\n//gs;
my ( $msg, $level );
if (/lmLog/) {
/lmLog\s*\(\s*(.+?)\s*,\s*(['"])(info|notice|warn|error)\2/s
or next;
( $msg, $level ) = ( $1, $3 );
}
else {
$level = 'error';
/STDERR\s+(.*)(?:\s+if\s*\()?;$/ or next;
$msg = $1;
}
push @{ $errorMsg->{$module}->{$level} }, $msg;
}
close F;
}
print "\n###### " . uc($module) . " ######\n";
foreach my $level (qw(error warn notice info)) {
foreach ( @{ $errorMsg->{$module}->{$level} } ) {
print "[$level] $_\n";
}
}
}