View | Details | Raw Unified | Return to bug 39367
Collapse All | Expand All

(-)a/misc/devel/add_missing_pod.pl (-1 / +69 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
use Modern::Perl;
3
use Pod::Coverage;
4
use File::Find;
5
6
my @files;
7
push @files, qx{git ls-files '*.pm'};
8
9
while ( my ( $i, $file ) = each @files ) {
10
    chomp $file;
11
    say sprintf "%s (%s/%s)", $file, $i + 1, scalar @files;
12
    check_pod_coverage($file);
13
}
14
15
# Function to check POD coverage and add missing POD
16
sub check_pod_coverage {
17
    my ($file) = @_;
18
    my $package_name = get_package_name($file);
19
20
    # Check for missing POD
21
    my $coverage = Pod::Coverage->new( package => $package_name );
22
    my @missing  = $coverage->uncovered;
23
24
    if (@missing) {
25
        print "Adding missing POD for $file\n";
26
        add_missing_pod( $file, \@missing );
27
    } else {
28
        print "No missing POD in $file\n";
29
    }
30
}
31
32
# Function to get the package name from the file
33
sub get_package_name {
34
    my ($file) = @_;
35
    open my $fh, '<', $file or die "Cannot open file: $!";
36
    my $package_name;
37
    while ( my $line = <$fh> ) {
38
        if ( $line =~ /^package\s+(\S+);/ ) {
39
            $package_name = $1;
40
            last;
41
        }
42
    }
43
    close $fh;
44
    return $package_name;
45
}
46
47
# Function to add missing POD to the file
48
sub add_missing_pod {
49
    my ( $file, $missing_ref ) = @_;
50
    open my $fh, '+<', $file or die "Cannot open file: $!";
51
    my @lines = <$fh>;
52
    seek $fh, 0, 0;
53
    truncate $fh, 0;
54
55
    my $missing = { map { $_ => 1 } @$missing_ref };
56
57
    foreach my $line (@lines) {
58
        foreach my $sub ( keys %$missing ) {
59
            if ( $line =~ /^\s*sub\s+$sub\s*{/ ) {
60
                print $fh "=head2 $sub\n\nMissing POD for $sub.\n\n=cut\n\n";
61
                delete $missing->{$sub};
62
                last;
63
            }
64
        }
65
        print $fh $line;
66
    }
67
    close $fh;
68
}
69

Return to bug 39367