#!/usr/bin/env perl # perldoc.jp用の未使用パッケージ検出スクリプト use strict; use warnings; use File::Find; use File::Spec; # 設定(ハードコード) my $BASE_DIR = '.'; my @ENTRY_POINTS = ('app.psgi'); my @ENTRY_DIRS = ('script'); # これらのディレクトリ配下の全ファイルをエントリーポイントとして扱う my @IGNORE_PATTERNS = ( 'PJP::M::', # Module::Find::useall で動的ロード ); sub find_perl_files { my $dir = shift; my @files; return () unless -d $dir; File::Find::find(sub { push @files, $File::Find::name if /\.pm$/; }, $dir); return @files; } sub extract_package_name { my $file = shift; open my $fh, '<', $file or return; while (<$fh>) { if (/^\s*package\s+([\w:]+)/) { close $fh; return $1; } } close $fh; return; } sub extract_used_packages { my $file = shift; my @packages; open my $fh, '<', $file or return (); while (<$fh>) { # use Package if (/^\s*use\s+([\w:]+)/) { push @packages, $1; } # use parent qw/Package1 Package2/ if (/^\s*use\s+parent\s+qw[\/\(]([^\/\)]+)[\)\/]/) { push @packages, split /\s+/, $1; } # use parent 'Package' if (/^\s*use\s+parent\s+['"]([^'"]+)['"]/) { push @packages, $1; } # Package->method if (/([\w:]+)->\w+/) { push @packages, $1 if $1 =~ /::/; } } close $fh; return @packages; } sub should_ignore { my $pkg = shift; return 1 unless defined $pkg; for my $pattern (@IGNORE_PATTERNS) { return 1 if $pkg =~ /^\Q$pattern\E/; } return 0; } # lib/以下の全パッケージを取得 my @lib_files = find_perl_files('lib'); my %all_packages; my %file_to_package; for my $file (@lib_files) { my $pkg = extract_package_name($file); next unless $pkg; next if should_ignore($pkg); $all_packages{$pkg} = $file; $file_to_package{$file} = $pkg; } # エントリーポイントとscript/から直接使用されているパッケージ my %directly_used; # エントリーポイント処理 for my $entry (@ENTRY_POINTS) { my $file = File::Spec->catfile($BASE_DIR, $entry); if (-f $file) { warn "Processing entry point: $entry\n"; for my $pkg (extract_used_packages($file)) { $directly_used{$pkg} = 1 unless should_ignore($pkg); } } } # エントリーディレクトリ処理(配下の全ファイルをエントリーポイントとして扱う) for my $dir (@ENTRY_DIRS) { next unless -d $dir; File::Find::find(sub { return unless -f $_; warn "Processing entry file: $File::Find::name\n"; for my $pkg (extract_used_packages($File::Find::name)) { $directly_used{$pkg} = 1 unless should_ignore($pkg); } }, $dir); } # 依存関係グラフ構築 my %deps; for my $file (@lib_files) { my $pkg = $file_to_package{$file}; next unless $pkg; my @used = extract_used_packages($file); $deps{$pkg} = [grep { defined $_ && !should_ignore($_) && exists $all_packages{$_} } @used]; } # 到達可能性分析 my %reachable = %directly_used; my $changed = 1; my $iteration = 0; while ($changed) { $iteration++; $changed = 0; my $old_size = scalar(keys %reachable); for my $pkg (keys %reachable) { if ($deps{$pkg}) { for my $dep (@{$deps{$pkg}}) { unless ($reachable{$dep}) { $reachable{$dep} = 1; $changed = 1; } } } } warn "Iteration $iteration: " . scalar(keys %reachable) . " reachable packages (+". (scalar(keys %reachable) - $old_size) .")\n"; last if $iteration > 100; # 無限ループ防止 } # 未使用パッケージを出力 for my $pkg (sort keys %all_packages) { unless ($reachable{$pkg}) { print "$all_packages{$pkg}\n"; } } warn "Found " . scalar(grep { !$reachable{$_} } keys %all_packages) . " unused packages\n";