From b5eb32bbc4547482e72a6c2b92894bb7e5249d18 Mon Sep 17 00:00:00 2001
From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Tue, 24 Dec 2024 09:13:16 -0800
Subject: [PATCH] activate --dump-unique-keys

---
 lib/Perl/Tidy.pm           |  2 ++
 lib/Perl/Tidy/Formatter.pm | 53 ++++++++++++++++++++++----------------
 2 files changed, 33 insertions(+), 22 deletions(-)

diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm
index 28e635c2..7628574a 100644
--- a/lib/Perl/Tidy.pm
+++ b/lib/Perl/Tidy.pm
@@ -931,6 +931,7 @@ EOM
         dump-mixed-call-parens
         dump-mismatched-args
         dump-mismatched-returns
+        dump-unique-keys
         )
       )
     {
@@ -3823,6 +3824,7 @@ sub generate_options {
     $add_option->( 'dump-short-names',                'dsn',   '!' );
     $add_option->( 'dump-token-types',                'dtt',   '!' );
     $add_option->( 'dump-unusual-variables',          'duv',   '!' );
+    $add_option->( 'dump-unique-keys',                'duk',   '!' );
     $add_option->( 'dump-want-left-space',            'dwls',  '!' );
     $add_option->( 'dump-want-right-space',           'dwrs',  '!' );
     $add_option->( 'fuzzy-line-length',               'fll',   '!' );
diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 8df53377..7c62159b 100644
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -8093,13 +8093,11 @@ EOM
         $self->find_multiline_qw($rqw_lines);
     }
 
-##    POSSIBLE FUTURE OPTION:
-##    # Dump unique hash keys
-##    $rOpts->{'dump-unique-hash_keys'}=1;
-##    if ( $rOpts->{'dump-unique-hash_keys'} ) {
-##        $self->dump_unique_hash_keys();
-##        Exit(0);
-##    }
+    # Dump unique hash keys
+    if ( $rOpts->{'dump-unique-keys'} ) {
+        $self->dump_unique_keys();
+        Exit(0);
+    }
 
     # Dump any requested block summary data
     if ( $rOpts->{'dump-block-summary'} ) {
@@ -8805,16 +8803,16 @@ sub follow_if_chain {
     return $rchain;
 } ## end sub follow_if_chain
 
-sub dump_unique_hash_keys {
+sub dump_unique_keys {
     my ($self) = @_;
 
-    # NOTE: This is a possible future dump option, still under development
-    # Implement --dump-unique-hash-keys; -duk?
-    # Look through all tokens and dump list of hash keys used just one time
+    # Implement --dump-unique-keys, -duk
+    # Dump a list of hash keys used just one time
 
     my $rLL                 = $self->[_rLL_];
     my $Klimit              = $self->[_Klimit_];
     my $ris_list_by_seqno   = $self->[_ris_list_by_seqno_];
+    my $K_opening_container = $self->[_K_opening_container_];
     my $K_closing_container = $self->[_K_closing_container_];
 
     my $KK = -1;
@@ -8827,7 +8825,7 @@ sub dump_unique_hash_keys {
     # Main loop to examine all hash keys and quotes
     #----------------------------------------------
     my @Q_list;
-    my @q_list;
+    my @K_start_qw_list;
     my $rwords = {};
 
     my $push_KK_last_nb = sub {
@@ -8887,14 +8885,18 @@ sub dump_unique_hash_keys {
         $KK_this_nb = $KK;
         my $seqno = $rLL->[$KK]->[_TYPE_SEQUENCE_];
         if ($seqno) {
-            ##my $token = $rLL->[$KK]->[_TOKEN_];
             if ( $is_opening_type{$type} ) {
-
+                ## nothing special todo yet
             }
             else {
-
                 # closing hash brace, '}'
                 if ( $type eq 'R' ) {
+
+                    # require a single item within the hash braces
+                    my $Ko = $K_opening_container->{$seqno};
+                    next if ( !defined($Ko) );
+                    my $Kn = $self->K_next_code($Ko);
+                    next if ( !defined($Kn) || $Kn != $KK_last_nb );
                     $push_KK_last_nb->();
                 }
             }
@@ -8910,7 +8912,11 @@ sub dump_unique_hash_keys {
                 push @Q_list, $KK;
             }
             elsif ( $type eq 'q' ) {
-                push @q_list, $KK;
+                if ( !defined($KK_last_nb)
+                    || $rLL->[$KK_last_nb]->[_TYPE_] ne 'q' )
+                {
+                    push @K_start_qw_list, $KK;
+                }
             }
             elsif ( $type eq 'k' ) {
 
@@ -8979,11 +8985,14 @@ sub dump_unique_hash_keys {
 
     return if ( !%unique_words );
 
-    # TODO: check each remaining word against the list of type q tokens
-    foreach my $K_uu (@q_list) {
-
-        # TODO: may need to check for multiline
-
+    # Remove any keys which are also in a qw list
+    foreach my $Kqw (@K_start_qw_list) {
+        my ( $K_last_q_uu, $rlist ) = $self->get_qw_list($Kqw);
+        foreach my $word ( @{$rlist} ) {
+            if ( $unique_words{$word} ) {
+                delete $unique_words{$word};
+            }
+        }
     }
 
     return if ( !%unique_words );
@@ -9012,7 +9021,7 @@ EOM
 
     return;
 
-} ## end sub dump_unique_hash_keys
+} ## end sub dump_unique_keys
 
 sub dump_block_summary {
     my ($self) = @_;
-- 
2.39.5