From 12f06af7d9eb9b03b1aa1f84293eb3330a288bfb Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Tue, 18 Mar 2025 14:01:46 +0100 Subject: [PATCH] Bug 39367: [DO NOT PUSH] Add script --- misc/devel/add_missing_pod.pl | 69 +++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100644 misc/devel/add_missing_pod.pl diff --git a/misc/devel/add_missing_pod.pl b/misc/devel/add_missing_pod.pl new file mode 100644 index 00000000000..40b1f5867f5 --- /dev/null +++ b/misc/devel/add_missing_pod.pl @@ -0,0 +1,69 @@ +#!/usr/bin/perl +use Modern::Perl; +use Pod::Coverage; +use File::Find; + +my @files; +push @files, qx{git ls-files '*.pm'}; + +while ( my ( $i, $file ) = each @files ) { + chomp $file; + say sprintf "%s (%s/%s)", $file, $i + 1, scalar @files; + check_pod_coverage($file); +} + +# Function to check POD coverage and add missing POD +sub check_pod_coverage { + my ($file) = @_; + my $package_name = get_package_name($file); + + # Check for missing POD + my $coverage = Pod::Coverage->new( package => $package_name ); + my @missing = $coverage->uncovered; + + if (@missing) { + print "Adding missing POD for $file\n"; + add_missing_pod( $file, \@missing ); + } else { + print "No missing POD in $file\n"; + } +} + +# Function to get the package name from the file +sub get_package_name { + my ($file) = @_; + open my $fh, '<', $file or die "Cannot open file: $!"; + my $package_name; + while ( my $line = <$fh> ) { + if ( $line =~ /^package\s+(\S+);/ ) { + $package_name = $1; + last; + } + } + close $fh; + return $package_name; +} + +# Function to add missing POD to the file +sub add_missing_pod { + my ( $file, $missing_ref ) = @_; + open my $fh, '+<', $file or die "Cannot open file: $!"; + my @lines = <$fh>; + seek $fh, 0, 0; + truncate $fh, 0; + + my $missing = { map { $_ => 1 } @$missing_ref }; + + foreach my $line (@lines) { + foreach my $sub ( keys %$missing ) { + if ( $line =~ /^\s*sub\s+$sub\s*{/ ) { + print $fh "=head2 $sub\n\nMissing POD for $sub.\n\n=cut\n\n"; + delete $missing->{$sub}; + last; + } + } + print $fh $line; + } + close $fh; +} + -- 2.34.1