find-unused-packages-for-perldoc-jp.pl

#!/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";