view release on metacpan or  search on metacpan

script/gen-stopwords  view on Meta::CPAN

sub load_global_words {
    my ($path, $list) = @_;
    return unless !$opt{no_global} && -e $path;

    open my $fh, '<', $path
        or do { warn_ "WARNING: Cannot open $path: $!"; return };

    my @lines = <$fh>;
    close $fh;

    shift @lines;    # skip aspell header line

    my $count = 0;
    for (@lines) {
        next unless /\S/;
        s/^\s+|\s+$//g;
        $list->{ lc($_) }++;
        $count++;
    }

    debug("  Loaded $count word(s) from $path");
}
#
#
# 2. Scan source files and collect unrecognised words via aspell

sub scan_project {
    my ($dirs, $lang, $stop_file, $list) = @_;

    my $stop_abs = eval { abs_path($stop_file) } // $stop_file;
    my $processed = 0;
    my $skipped   = 0;

    find({
        wanted => sub {
            my $name = $_;

            # Prune unwanted directories
            if (-d $name && $name =~ $PRUNE_RE) {
                $File::Find::prune = 1;
                return;
            }

            return unless -f $name && $name =~ $SOURCE_RE;

            # Never process the output file itself
            my $abs = eval { abs_path($name) } // $name;
            if ($abs eq $stop_abs) {
                $skipped++;
                return;
            }

            debug("  Processing: $File::Find::name");
            $processed++;

            open my $fh, '<', $name
                or do { warn_ "WARNING: Cannot open $File::Find::name: $!"; return };

            while (my $line = <$fh>) {
                # Strip POD formatting codes entirely (E<gt>, L<...>, C<...>, etc.)
                # Removing the whole tag prevents fragments like 'gt' or 'Egt' appearing.
                $line =~ s/[A-Z]<[^>]+>//g;

                my $result = aspell_list($line, $lang);
                next unless $result;

                for my $word (split /\n/, $result) {
                    $word =~ s/^\s+|\s+$//g;
                    next unless length($word) >= $opt{min_len};

                    my $clean = lc($word);
                    $clean =~ s/'s$//;    # strip possessive

                    $list->{$clean}++;
                }
            }

            close $fh;
        },
        no_chdir => 0,
    }, @$dirs);

    return ($processed, $skipped);
}

#
#
# 3. Write .stopwords

sub write_stopwords {
    my ($path, $lang, $list) = @_;

    if ($opt{dry_run}) {
        info("DRY RUN - would write " . scalar(keys %$list) . " term(s) to $path");
        if ($opt{verbose}) {
            print "  $_\n" for sort keys %$list;
        }
        return;
    }

    open my $fh, '>', $path
        or die "ERROR: Cannot write to $path: $!\n";

    print $fh "# Auto-generated stopwords for $lang\n";
    print $fh "# Generated by gen-stopwords $VERSION on " . localtime() . "\n";
    print $fh "# Do not edit manually - re-run gen-stopwords to regenerate.\n";
    print $fh join("\n", sort keys %$list), "\n";

    close $fh;
}

#
#
# MAIN

check_aspell();

info("gen-stopwords $VERSION");
info("Language : $opt{lang}");
info("Output   : $opt{output}");
info("Dirs     : " . join(', ', @{ $opt{dirs} }));