Re^2: Check if key exist in hash but not exact match

I tinkered with my previous code (Re: Check if key exist in hash but not exact match) and made a couple of improvements.

The potentially ambiguous "Enter whole or partial name for key (Enter to exit)" is now "Enter whole or partial name for key (just hit Return to exit).".

Where a match only differs in case, it is shown as NO_CASE instead of PARTIAL; for example, Cola matches cola if case is ignored:

Name: Cola
Match   Key         Value
-----   ---         -----
NO_CASE cola        1.25
PARTIAL Coca Cola   1.25
PARTIAL Pepsi Cola  1.25
PARTIAL Undead Cola <undefined>
[download]

As there are only a few code changes, and the sample run is the same as before except for the Name: Cola (shown above), I've put all of this in a spoiler (view at your leisure).

New code:

#!/usr/bin/env perl

use v5.36;

use List::Util qw{first max};

my %price = (
    'Coca Cola'   =>  1.25,
    coke          =>  1.25,
    cola          =>  1.25,
    'Pepsi Cola'  =>  1.25,
    pizza         => 12.00,
    sandwich      =>  3.00,
    'Undead Cola' => undef,
);

say 'Enter whole or partial name for key (just hit Return to exit).';

while (1) {
    print "\nName: ";
    my $name = <STDIN>;
    chomp $name;

    unless (length $name) {
        say 'Exiting ...';
        last;
    }

    unless ($name =~ /^[A-Za-z0-9 ]+$/) {
        say 'Only alphanumeric+space name searches allowed.';
        next;
    }

    check_keys(\%price, $name);
}

sub check_keys ($hash, $name) {
    my $fmt = "%-7s %-@{[max map length, keys %$hash]}s %s\n";
    my @matches = grep /$name/i, keys %$hash;

    if (@matches) {
        printf $fmt, qw{Match Key Value};
        printf $fmt, qw{----- --- -----};

        if (exists $hash->{$name}) {
            @matches = grep !/^$name$/, @matches;
            printf $fmt, 'EXACT', $name, $hash->{$name} // '<undefined
+>';
        }

        if (@matches) {
            my $no_case = first {/^$name$/i} @matches;

            if ($no_case) {
                @matches = grep !/^$no_case$/, @matches;
                printf $fmt,
                    'NO_CASE', $no_case, $hash->{$no_case} // '<undefi
+ned>';
            }

            if (@matches) {
                for my $match (sort @matches) {
                    printf $fmt,
                        'PARTIAL', $match, $hash->{$match} // '<undefi
+ned>';
                }
            }
        }
    }
    else {
        say "No keys match '$name'.";
    }

    return;
}
[download]

New sample run (same inputs as previously used):

Enter whole or partial name for key (just hit Return to exit).

Name: cok
Match   Key         Value
-----   ---         -----
PARTIAL coke        1.25

Name: col
Match   Key         Value
-----   ---         -----
PARTIAL Coca Cola   1.25
PARTIAL Pepsi Cola  1.25
PARTIAL Undead Cola <undefined>
PARTIAL cola        1.25

Name: Coca Cola
Match   Key         Value
-----   ---         -----
EXACT   Coca Cola   1.25

Name: Undead Cola
Match   Key         Value
-----   ---         -----
EXACT   Undead Cola <undefined>

Name: Cola
Match   Key         Value
-----   ---         -----
NO_CASE cola        1.25
PARTIAL Coca Cola   1.25
PARTIAL Pepsi Cola  1.25
PARTIAL Undead Cola <undefined>

Name: cola
Match   Key         Value
-----   ---         -----
EXACT   cola        1.25
PARTIAL Coca Cola   1.25
PARTIAL Pepsi Cola  1.25
PARTIAL Undead Cola <undefined>

Name: ^cola$
Only alphanumeric+space name searches allowed.

Name: (?{/path/to/evil_code})
Only alphanumeric+space name searches allowed.

Name: Nightingale Tongues in Aspic
No keys match 'Nightingale Tongues in Aspic'.

Name:
Exiting ...
[download]

— Ken

Comment on Re^2: Check if key exist in hash but not exact match Select or Download Code

Replies are listed 'Best First'.
Re^3: Check if key exist in hash but not exact match by kcott (Archbishop) on Apr 04, 2023 at 19:21 UTC
I tinkered some more: There was a bug which I've fixed. I've no idea why, but I'd coded for only one NO_CASE. Obviously, you can have ABC, Abc, abc, AbC, and so on. I decided that I was doing too much work with `@matches`. I changed that to `%matches` and, instead of removing elements from the array by recreating it using `grep`, I'm simply using `delete` to remove key/value pairs. This resulted in much cleaner code and, I imagine, would be a lot more efficient. There was also an interesting point regarding the contents of the "Value" column produced by `printf`. Having introduced `undef` values in my test data for basic edge-case checks, this meant that there was either a price (number) or '`<undefined>`' (string). A `%s` worked fine for both when the price was `1.25`; however, a price of `3.00` was converted to just `3`. My introduction of `undef` may have been completely artificial and would never occur in the OP's data: in this case, a `%.2f` would probably suffice throughout. I've left the `undef` values as it was an interesting exercise dealing with this. I can see potential improvements here but won't go into that further unless it is something the OP really wants. As before, I'll put the new code and another sample run in a spoiler. Code: #!/usr/bin/env perl use v5.36; use List::Util 'max'; my %price = ( 'Coca Cola' => 1.25, coke => 1.25, COLA => 1.25, Cola => 1.25, cola => 1.25, 'Pepsi Cola' => 1.25, pizza => 12.00, sandwich => 3.00, 'UNDEAD COLA' => undef, 'Undead Cola' => undef, 'Undead cola' => undef, 'undead cola' => undef, ); say 'Enter whole or partial name for key (just hit Return to exit).'; while (1) { print "\nName: "; my $name = <STDIN>; chomp $name; unless (length $name) { say 'Exiting ...'; last; } unless ($name =~ /^[A-Za-z0-9 ]+$/) { say 'Only alphanumeric+space name searches allowed.'; next; } check_keys(\%price, $name); } sub check_keys ($hash, $name) { my %matches = map +($_ => 1), grep /$name/i, keys %$hash; if (keys %matches) { _printf_head($hash); if (exists $matches{$name}) { _printf($hash, 'EXACT', $name); delete $matches{$name}; } } else { say "No keys match '$name'."; return; } for (grep /^$name$/i, sort keys %matches) { _printf($hash, 'NO_CASE', $_); delete $matches{$_}; } for (sort keys %matches) { _printf($hash, 'PARTIAL', $_); } return; } sub _printf ($hash, $match, $key) { my $fmt = "%-7s %-@{[max map length, keys %$hash]}s "; $fmt .= defined $hash->{$key} ? "%.2f\n" : "%s\n"; printf $fmt, $match, $key, $hash->{$key} // '<undefined>'; return; } sub _printf_head ($hash) { my $fmt = "%-7s %-@{[max map length, keys %$hash]}s %s\n"; printf $fmt, qw{Match Key Value}; printf $fmt, qw{----- --- -----}; return; } [download] Sample run: Enter whole or partial name for key (just hit Return to exit). Name: cok Match Key Value ----- --- ----- PARTIAL coke 1.25 Name: col Match Key Value ----- --- ----- PARTIAL COLA 1.25 PARTIAL Coca Cola 1.25 PARTIAL Cola 1.25 PARTIAL Pepsi Cola 1.25 PARTIAL UNDEAD COLA <undefined> PARTIAL Undead Cola <undefined> PARTIAL Undead cola <undefined> PARTIAL cola 1.25 PARTIAL undead cola <undefined> Name: Coca Cola Match Key Value ----- --- ----- EXACT Coca Cola 1.25 Name: Undead Cola Match Key Value ----- --- ----- EXACT Undead Cola <undefined> NO_CASE UNDEAD COLA <undefined> NO_CASE Undead cola <undefined> NO_CASE undead cola <undefined> Name: Cola Match Key Value ----- --- ----- EXACT Cola 1.25 NO_CASE COLA 1.25 NO_CASE cola 1.25 PARTIAL Coca Cola 1.25 PARTIAL Pepsi Cola 1.25 PARTIAL UNDEAD COLA <undefined> PARTIAL Undead Cola <undefined> PARTIAL Undead cola <undefined> PARTIAL undead cola <undefined> Name: cola Match Key Value ----- --- ----- EXACT cola 1.25 NO_CASE COLA 1.25 NO_CASE Cola 1.25 PARTIAL Coca Cola 1.25 PARTIAL Pepsi Cola 1.25 PARTIAL UNDEAD COLA <undefined> PARTIAL Undead Cola <undefined> PARTIAL Undead cola <undefined> PARTIAL undead cola <undefined> Name: ^cola$ Only alphanumeric+space name searches allowed. Name: (?{/path/to/evil_code}) Only alphanumeric+space name searches allowed. Name: Nightingale Tongues in Aspic No keys match 'Nightingale Tongues in Aspic'. Name: p Match Key Value ----- --- ----- PARTIAL Pepsi Cola 1.25 PARTIAL pizza 12.00 Name: s Match Key Value ----- --- ----- PARTIAL Pepsi Cola 1.25 PARTIAL sandwich 3.00 Name: Exiting ... [download] — Ken	[reply] [d/l] [select]
Re^4: Check if key exist in hash but not exact match by ibm1620 (Hermit) on Apr 04, 2023 at 21:36 UTC
`my $fmt = "%-7s %-@{[max map length, keys %$hash]}s ";` [download] Definitely adding this to my snippet file! But I've never seen this syntax before. What is triggering the code evaluation of max(...) here?	[reply] [d/l]
Re^5: Check if key exist in hash but not exact match ( meaning of " @{[...]} " ) by LanX (Saint) on Apr 04, 2023 at 21:51 UTC
> What is triggering the code evaluation of max(...) here? `" @{[...]} "` is an idiomatic pseudo-operator by combining several mechanisms String interpolation work not only for arrays but also for dereferencing of arrays. `" @{$a_ref} "` The `[...]` marks an anonymous array-ref. `" @{[ 1, 2, 3 ]} "` Lists can also include code statements to be executed `" @{[ 1, 2, some_code() ]} "` The returned list will be included into the string. `DB<6> p ">>> @{[ 1, 2, time() ]} <<<" >>> 1 2 1680647910 <<< DB<7>` [download] Cheers Rolf _{(addicted to the 𐍀𐌴𐍂𐌻 Programming Language :) Wikisyntax for the Monastery} update added code examples for each step	[reply] [d/l] [select]
Re^5: Check if key exist in hash but not exact match by eyepopslikeamosquito (Archbishop) on Apr 04, 2023 at 22:23 UTC
Definitely adding this to my snippet file! But I've never seen this syntax before. `@{[]}` is the famous Baby Cart Secret Operator. I must say I'm shocked LanX didn't mention his visualization of this operator, namely "a guy with sombrero dragging a sled(ge) uphill" ... which is why he usually refers to it as the Mexican Sledge operator. See also: Secret Operator References	[reply] [d/l]
Re^5: Check if key exist in hash but not exact match by kcott (Archbishop) on Apr 04, 2023 at 22:41 UTC
G'day ibm1620, The `@{[...]}` construct is one of many that are referred to as "Perl secret operators and constants". This one, called "Baby cart", has been around for a very long time. Follow that link for an answer to your question as well as other information. I have been using it since the 1990s and, as I recall, wasn't even aware that it was a perlsecret until much later. I think I first encountered it in one of the "O'Reilly Perl books". I don't remember which one; although, "Advanced Perl Programming" is a likely candidate. Note that's the original edition; "Advanced Perl Programming, 2nd edition" is completely different — a very poor choice of title in my opinion. — Ken	[reply] [d/l]
Re^6: Check if key exist in hash but not exact match by ibm1620 (Hermit) on Apr 05, 2023 at 12:11 UTC

update