Skip to content

Instantly share code, notes, and snippets.

@hitode909

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

Created October 30, 2025 22:14
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save hitode909/0cf076ffa60e026688d2d3efc38e33fc to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save hitode909/0cf076ffa60e026688d2d3efc38e33fc to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. hitode909 created this gist Oct 30, 2025.
    154 changes: 154 additions & 0 deletions find-unused-packages-for-perldoc-jp.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,154 @@
    #!/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";