#!c:\perl\bin\perl.exe use strict; use warnings; use constant CODE => '/path/to/code/rootdir/'; use File::Find; my %source; find( \&wanted, CODE ); ## ## pkg( $filename ) ## Determina o pacote (package) que o arquivo implementa. ## sub pkg{ my $file = shift; my $pack; open FILE, $file or die $1; while( ){ if( m{^package\s+([\w:]+)\s*} ){ $pack = $1; last; } } close FILE or die $1; return $pack; } ## ## uses( $filename ) ## Determina as bibliotecas que este módulo|script usa|requer. ## sub uses{ my $file = shift; my %libs; open FILE, $file or die $1; while( ){ $libs{ $1 }++ if m/^\s*(?:use|require)\s+(\S+).*?;/; } close FILE or die $!; return wantarray ? ( keys %libs ) : [ keys %libs ]; } ## ## loc( $filename ) ## Conta as linhas de código existentes em um determinado arquivo. ## sub loc{ my( $file, $counter ) = ( shift ); open FILE, $file or die $!; $counter++ while( ); close FILE or die $!; return $counter; } ## ## subs( $filename ) ## Determina o nome das subrotinas declaradas em $filename. ## sub subs{ my $file = shift; my @subs; my $package; open FILE, $file or die $1; while( ){ $package = $1 if m{^package\s+([\w:]+)\s*}; push @subs, $1 if /^sub\s+([\w:]+)/; } close FILE or die $1; @subs = map { s/$package\:\://o; $_ } @subs if $package; return wantarray? @subs : \@subs; } ## ## version( $filename ) ## Tenta determinar a versão do módulo ou script ## inspecionando a variável $VERSION definida por ele. ## sub version{ my $file = shift; my $version; open FILE, $file or die $1; while( ){ if( m/VERSION\s*=\s*/ ){ $version = $_; last; } } close FILE or die $1; { no strict; if( $version ){ eval $version; $version = $VERSION; $version = '0.1' if $version =~ /Revision/; }else{ $version = ''; } } return $@? $@ : $version; } ## ## wanted( $filename ) ## Determina se desejamos ou não contar com este arquivo na nossa avaliação. ## Chamada como call-back pelo File::Find::find. ## sub wanted{ my $f; my $file = $_; return unless ( -f && /\.(p[lm])$/ ); my $type = ( $1 eq 'pl' ? 'script' : 'module' ); ( $f = $File::Find::name ) =~ s{CODE}{}o; $source{ $f } = { type => $type, name => $file, filename => $f, LoC => loc( $File::Find::name ), 'package' => pkg( $File::Find::name ) || 'main', libs => uses( $File::Find::name ) || [], subs => subs( $File::Find::name ) || [], version => version( $File::Find::name ), }; } my $packages; for my $file ( keys %source ){ push @{$packages->{ $source{$file}->{package}||'main' }}, $source{$file}; } # use Data::Dumper; # print Dumper( $packages ); # print Dumper( \%source ); print q{ Relatório de Análise do Código Fonte

Relatório de Análise do Código Fonte

}; my $total_loc = 0; my $total_subs = 0; my $total_packages = scalar keys %$packages; my $total_files = scalar keys %source; map { map { $total_loc += $_->{LoC} } @$_ } values %$packages; map { map { $total_subs += scalar @{$_->{subs}} } @$_ } values %$packages; print qq{

Total pacotes: $total_packages.
Total Arquivos: $total_files.
Total linhas: $total_loc.
Subrotinas: $total_subs.

\n\n}; foreach my $pack( sort keys %$packages ){ my @files = sort { $a->{name} cmp $b->{name} } @{$packages->{$pack}}; my $package = $files[0]->{package} || 'main'; print qq{ \n}; }