From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Sun, 29 Dec 2024 16:15:26 +0000 (-0800)
Subject: add -duk docs
X-Git-Tag: 20240903.09~1
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=bcde45c797c7a7c3bc10c8904f95dfdc325c7f48;p=perltidy.git

add -duk docs
---

diff --git a/CHANGES.md b/CHANGES.md
index d540d051..7190f8d9 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,14 @@
 
 ## 2024 09 03.08
 
+    - A new parameter --dump-unique-keys, or B<-duk>, dumps a list of hash keys
+      which appear to be used just once, and do not appear among the quoted
+      strings in a file. For example:
+
+         perltidy -duk File.pm >output.txt
+
+      The purpose is to help locate misspelled hash keys.
+
     - Line breaks at long chains of method calls now break at all calls
       with args in parens, as in this example from git #171
 
diff --git a/bin/perltidy b/bin/perltidy
index e80cf413..d51e20b8 100644
--- a/bin/perltidy
+++ b/bin/perltidy
@@ -6554,6 +6554,23 @@ this wildcard suffix is in the exclusion list:
 
     -wvxl='*_uu'
 
+=item B<Use --dump-unique-keys> to help locate misspelled hash keys
+
+The parameter B<--dump-unique-keys>, or B<-duk>, dumps a list of hash keys
+which appear to be used just once, and do not appear among the quoted
+strings in a file. For example:
+
+   perltidy -duk File.pm >output.txt
+
+The lines in the output file list each unique key and its line number.
+Typically, most of the listed keys listed will be perfectly valid keys needed,
+for example, for communication with other modules or for future development.
+But the list might also include something unexpected, such as a misspelled key.
+
+A program C<dump_unique_keys.pl> at
+L<https://github.com/perltidy/perltidy/tree/master/examples> can run perltidy
+with B<-duk> on multiple files, and then remove any common keys from the list.
+
 =item B<Use --dump-mixed-call-parens to find functions called both with and without parens>
 
 The parameter B<--dump-mixed-call-parens>, or B<-dmcp>, provides information on
diff --git a/examples/dump_unique_keys.pl b/examples/dump_unique_keys.pl
index badf9b9f..7cecffc6 100755
--- a/examples/dump_unique_keys.pl
+++ b/examples/dump_unique_keys.pl
@@ -4,72 +4,107 @@ use warnings;
 use File::Temp qw{ tempfile };
 
 # Run perltidy --dump-unique-keys on multiple files, and
-# just show keys which only appear in one file.
+# show hash keys which just appear in one file.
 # Requires Perl::Tidy version 20240903.08 or higher
 
-my @files;
-my %seen;
-foreach my $file (@ARGV) {
-    if ( !-e $file ) { die "file '$file' not found\n" }
-    next if ( $seen{$file}++ );
-    push @files, $file;
-}
-
-# TODO:
-# - if no files, look for a MANIFEST, or
-# - if 1 file, see if it is a MANIFEST, and
-#   - get files of the form lib/*.pm
-if ( !@files ) { exit 1 }
-
-my ( $fh_tmp, $tmpfile ) = tempfile();
-if ( !$fh_tmp ) {
-    die "unable to open temporary file $tmpfile\n";
-}
-
-# Loop to run perltidy -duk on each file
-foreach my $file (@files) {
-    my $cmd = "perltidy -npro -duk $file >>$tmpfile";
-    my $err = system($cmd);
-    if ($err) { die "perltidy return error $err\n" }
-}
-
-my $fh;
-if ( !open( $fh, '<', $tmpfile ) ) {
-    die "cannot open my temp file '$tmpfile'\n";
-}
-
-my %word_count;
-my @lines;
-foreach my $line (<$fh>) {
-    my $word;
-    if ( $line =~ /^(.*),(\d+)\s*$/ ) {
-        $word = $1;
-        if ( !defined( $word_count{$word} ) ) {
-            $word_count{$word} = 1;
+main();
+
+sub main {
+
+    my $usage = <<EOM;
+Run perltidy --dump-unique-keys on multiple files
+Usage: $0 file1 file2 ...
+  if no files are given, look for MANIFEST and use files lib/.../*.pm
+EOM
+
+    my @files = @ARGV;
+
+    if ( !@files ) {
+        my $MANIFEST = "MANIFEST";
+        if ( -e $MANIFEST && -f $MANIFEST ) {
+            my $rfiles = read_MANIFEST($MANIFEST);
+            @files = @{$rfiles};
         }
-        else {
-            $word_count{$word}++;
+    }
+
+    if ( !@files ) { die $usage }
+
+    foreach my $file (@files) {
+        if ( !-e $file ) { die "file '$file' not found\n" }
+    }
+
+    my ( $fh_tmp, $tmpfile ) = tempfile();
+    if ( !$fh_tmp ) {
+        die "unable to open temporary file $tmpfile\n";
+    }
+
+    # Loop to run perltidy -duk on each file
+    my %seen;
+    foreach my $file (@files) {
+        next if ( $seen{$file}++ );
+        my $cmd = "perltidy -npro -duk $file >>$tmpfile";
+        my $err = system($cmd);
+        if ($err) { die "perltidy return error $err\n" }
+    }
+
+    my $fh;
+    if ( !open( $fh, '<', $tmpfile ) ) {
+        die "cannot open my temp file '$tmpfile': $!\n";
+    }
+
+    my %word_count;
+    my @lines;
+    foreach my $line (<$fh>) {
+        my $word;
+        if ( $line =~ /^(.*),(\d+)\s*$/ ) {
+            $word = $1;
+            if ( !defined( $word_count{$word} ) ) {
+                $word_count{$word} = 1;
+            }
+            else {
+                $word_count{$word}++;
+            }
+        }
+        push @lines, [ $line, $word ];
+    }
+    $fh->close();
+
+    my @dups = grep { $word_count{$_} > 1 } keys %word_count;
+    my %is_dup;
+    @is_dup{@dups} = (1) x scalar(@dups);
+
+    my $output_string = "";
+    foreach my $item (@lines) {
+        my ( $line, $word ) = @{$item};
+        next if ( defined($word) && $is_dup{$word} );
+        $output_string .= $line;
+    }
+
+    print {*STDOUT} $output_string;
+
+    END {
+        if ( defined($tmpfile) && -e $tmpfile ) {
+            unlink($tmpfile) or warn "Could not unlink $tmpfile: $!";
         }
     }
-    push @lines, [ $line, $word ];
-}
-$fh->close();
-
-my @dups = grep { $word_count{$_} > 1 } keys %word_count;
-my %is_dup;
-@is_dup{@dups} = (1) x scalar(@dups);
-
-my $output_string = "";
-foreach my $item (@lines) {
-    my ( $line, $word ) = @{$item};
-    next if ( defined($word) && $is_dup{$word} );
-    $output_string .= $line;
-}
-
-print {*STDOUT} $output_string;
-
-END {
-    if ( defined($tmpfile) && -e $tmpfile ) {
-        unlink $tmpfile or warn "Could not unlink $tmpfile: $!";
+} ## end sub main
+
+sub read_MANIFEST {
+    my ($MANIFEST) = @_;
+
+    # scan MANIFEST for existing files of the form 'lib/.../*.pm'
+    my $fh;
+    if ( !open( $fh, '<', $MANIFEST ) ) {
+        die "cannot open '$MANIFEST': $!\n";
+    }
+    my @files;
+    foreach my $line (<$fh>) {
+        chomp $line;
+        next unless $line;
+        my @parts = split '/', $line;
+        if ( $parts[0] ne 'lib' )     { next }
+        if ( $parts[-1] !~ /\.pm$/i ) { next }
+        if ( -e $line )               { push @files, $line }
     }
-}
+    return \@files;
+} ## end sub read_MANIFEST