I think that may all be more trouble than it is worth. One of the big reasons that the warnings pragma came to be was so that warnings didn't have to be an all or nothing proposition.

 
#!/usr/bin/perl
use strict; 
use warnings;

my ($foo, $bar);

print '1: ', $foo eq $bar, "\n";    # Uninitialized warning. 
{ 
    no warnings qw( uninitialized ); 
    print '2: ', $foo eq $bar, "\n";    # No warnings emitted.
}

print '3: ', $foo eq $bar, "\n";    # Warns again.
[download]

Update: If you insist on taking the long way though, here's something that might^^{probably won't} help.

Edit and Update: Added readmore tags and show a nasty bug with my definedness shortcuts.

-sauoq
"My two cents aren't worth a dime.";

I suppose that's a fair thing to assert. I'm not a huge fan of turning off alarms, but when it is the most efficient method, it's hard to argue otherwise.

Thanks for the pointer on 'uninitialized'. That's what I need.

Your solution doesnt handle existance mismatches correctly.

--- demerphq
my friends call me, usually because I'm late....

Other than the no warnings qw( uninitialized ); suggestion, my solution wasn't a complete solution and didn't pretend to be. That's why I prefaced it with the phrase, "here's something that might help."

-sauoq
"My two cents aren't worth a dime.";

elusion : http://matt.diephouse.com

Update: This wasn't in response to the hash aspect of the meditation, sorry.

In the hash table that I constructed, I put in 0 as a plausible value. It's a good habit to make, putting deliberately false values in your test data. You never know when you're going to do something odd. Form data, in particular, is one example.

Apart from the amusement factor, I think I've found a reasonable solution. Silly me.

my $chk = sub { (1 == grep defined, @_) or ($_[0] ne $_[1]) };
grep $chk->(values @{$h->{$_}}['O','C']), keys %$h;
[download]

Makeshifts last the longest.

To get the keys:

use FreezeThaw qw(cmpStr);

sub f {
    my ($h) = @_;
    return grep cmpStr(@{$h->{$_}}{qw/C O/}), keys %$h;
}
[download]

use FreezeThaw 'cmpStr';sub f{my($h)=@_;grep{!exists$$h{$_}{O}||cmpStr
+@{$$h{$_}}{C=>'O'}}keys%$h}
[download]

#        1         2               3         4         5
#23456789012345678901234      56789012345678901234567890

use FreezeThaw 'cmpStr';sub f{grep{!exists$$_{O}||cmpStr

#        6         7
#2345678901234567890123456

@$_{C=>'O'}}values%{$_[0]}}
[download]

- Yes, I reinvent wheels.
- Spam: Visit eurotraQ.

There are a couple of problems with most of the solutions to this problem posted so far.

They look great when applied to $x and $y, but...

1. Once you get the syntax for the hash references they don't look so golfed anymore,
2. Unless I have translated them wrongly, they don't actually work. They all miss on the ff case because they don't test for the existance of the key in the old hash.

I couldn't get aristotle's to run, because of the error shown in the comment below his code.

I didn't test Jeurd's entry as I didn't have FreezeThaw installed. It seems like a complicated way of disabling warnings though?

The results:

C:\test>201391
       Required: dd ff aa hh cc
-------------------------------
BrowserUK golf: dd ff aa hh cc
sauoq No warns: dd aa hh cc
     Sauoq golf: dd aa hh cc
   Elusion golf: aa cc dd
      BUK2 golf: dd ff aa hh cc
[download]

I attempted to translate the original code into a function where required and golf them all to an equal standard observing warnings, strict and safety. There maybe a few characters that could be trimmed from all of them without altering the original symantics.

The code:

I went and updated your code to incorporate my solutions, and in the process added a bunch of cases. Unfortunately this also caused your solution to generate warnings. I find it a touch suprising that my longer solution is the only one that works correctly on all the cases. Guys youve got to be more thorough in your testing!

use warnings;
use strict;
use Carp;
local $SIG{__WARN__}=sub {die("\t@{[(caller(1))[3]]}() generated warni
+ngs!\n")};

my $foo = {
     aa => { O => 'zz',  C => 'yy'  }, #
     bb => { O => 'xx',  C => 'xx'  },
     cc => { O => undef, C => 'ww'  }, #
     dd => { O => 'vv',  C => undef }, #
     ee => { O => undef, C => undef },
     ff => {             C => undef },
     gg => { O => 0,     C => 0     },
     hh => { O => undef, C => 0     }, #
     ii => { O => undef             }, #
     jj => { O => 0,     C => ' '   }, #
     kk => { O => ' ',   C => 0     }, #
     ll => { O => undef, C => ' '   }, #
     mm => { O => ' ',   C => undef }, #
};

sub BUK{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a
+->{$_}{C}}keys%$a}
sub snw{no warnings qw(uninitialized);my$h=pop;grep{$h->{$_}{O}ne$h->{
+$_}{C}}keys %$h}
sub sg_{my$h=pop;grep{!(defined($h->{$_}{O}&&$h->{$_}{C})&&$h->{$_}{O}
+eq$h->{$_}{C}||!defined($h->{$_}{O}||$h->{$_}{C}))}%$h}
sub eg_{my$h=pop;grep{!(($h->{$_}{O}||$;)eq($h->{$_}{C}||$;))}%$h}
sub ddf{$a=pop;grep{$b=$$a{$_};defined$$b{O}!=defined$$b{C}||defined$$
+b{O}&&$$b{O}ne$$b{C}}keys%$a}#98
sub dex{$a=pop;grep{$b=$$a{$_};exists$$b{O}!=exists$$b{C}||defined$$b{
+O}!=defined$$b{C}||defined$$b{O}&&$$b{O}ne$$b{C}}keys%$a}#126
sub tad{my($h)=@_;grep{!exists($h->{$_}->{O})||(defined($h->{$_}->{O})
+?(defined($h->{$_}->{C})?($h->{$_}->{O}ne$h->{$_}->{C}):1):defined($h
+->{$_}->{C}))}keys%$h}#162


print "      Required: aa cc dd ff hh ii jj kk ll mm\n";
print "---------------------------------------------\n";
eval { print "   tadman golf: @{[sort {$a cmp $b} tad($foo)]}\n"; };
print $@ if $@;

eval { print "BrowserUK golf: @{[sort {$a cmp $b} BUK($foo)]}\n"; };
print $@ if $@;

eval { print "sauoq No warns: @{[sort {$a cmp $b} snw($foo)]}\n"; };
print $@ if $@;

eval { print "    Sauoq golf: @{[sort {$a cmp $b} sg_($foo)]}\n"; };
print $@ if $@;

eval { print "  Elusion golf: @{[sort {$a cmp $b} eg_($foo)]}\n"; };
print $@ if $@;

eval { print " Demerphq defd: @{[sort {$a cmp $b} ddf($foo)]}\n"; };
print $@ if $@;

eval { print "Demerphq exist: @{[sort {$a cmp $b} dex($foo)]}\n"; };
print $@ if $@;
__END__
      Required: aa cc dd ff hh ii jj kk ll mm
---------------------------------------------
   tadman golf: aa cc dd ff hh jj kk ll mm
    main::BUK() generated warnings!
sauoq No warns: aa cc dd hh jj kk ll mm
    Sauoq golf: aa cc dd hh jj kk ll mm
  Elusion golf: aa cc dd jj kk ll mm
 Demerphq defd: aa cc dd hh jj kk ll mm
Demerphq exist: aa cc dd ff hh ii jj kk ll mm
[download]

Hmm, maybe it isnt so suprising considering its the longest with the exception of only tadmans solution

;-)

---
demerphq
my friends call me, usually because I'm late....

If you change the specs to the challenge, any thing is possible.

My version does not produce warnings under the terms of the challenge. Note:the localisation and setting of $^W=0.

---

Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!

I didn't test Juerd's entry as I didn't have FreezeThaw installed. It seems like a complicated way of disabling warnings though?

I'm not interested in disabling warnings. I either avoid them, or don't care about them.

I used FreezeThaw to demonstrate easier syntax.

different if ( defined $x and defined $y and $x ne $y )
          or not ( defined $x and defined $y );
[download]

vs

different if cmpStr($x, $y);
[download]

- Yes, I reinvent wheels.
- Spam: Visit eurotraQ.

Firstly, sorry for mis-spelling your name.

I also apologies for misunderstanding your intent. In the context of the thread, I looked at what FreezeThaw did, and couldn't see the difference between what it did in cmpStr($x,$y) and do{no warnings; $x eq $y). However, as I finally got FreezeThaw.pm installed on my system (actually just copied in as the install mechanism gave me inordanant troubles), I realise that it does more as my test script below shows.

#! perl -sw
use strict;
use FreezeThaw qw(cmpStr freeze);

sub asStr {
    return 'undef' if !defined $_[0];
    return "''" if $_[0] eq '';
    return '0' if $_[0] == 0;
    "$_[0]";
}

my @x = (0,1,'',undef);
my @y = (0,1,'',undef);

print '                  {$^W=0; ($x eq $y)', "\t", '!cmpStr($x,$y)', 
+$/;
for my $x (@x) {
    for my $y (@y) {
        printf '%5s -v- %5s :', asStr($x), asStr($y);

        print "\t", do{local $^W=0;($x eq $y) ? 'Same' : 'Diff';};

        print "\t\t",!cmpStr($x,$y) ? 'Same' : 'Diff', $/;
    }
}
[download]

Giving

C:\test>test
                  {$^W=0; ($x eq $y)    !cmpStr($x,$y)
     0 -v-     0 :       Same            Same
     0 -v-     1 :       Diff            Diff
     0 -v-    '' :       Diff            Diff
     0 -v- undef :       Diff            Diff
     1 -v-     0 :       Diff            Diff
     1 -v-     1 :       Same            Same
     1 -v-    '' :       Diff            Diff
     1 -v- undef :       Diff            Diff
    '' -v-     0 :       Diff            Diff
    '' -v-     1 :       Diff            Diff
    '' -v-    '' :       Same            Same
    '' -v- undef :       Same            Diff # Here!
undef -v-     0 :       Diff            Diff
undef -v-     1 :       Diff            Diff
undef -v-    '' :       Same            Diff # Here!
undef -v- undef :       Same            Same

 1:13:29.67 C:\test>
[download]

---

Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!

use warnings;
use strict;
my $foo = {
     aa => { O => 'zz',  C => 'yy'  }, #
     bb => { O => 'xx',  C => 'xx'  },
     cc => { O => undef, C => 'ww'  }, #
     dd => { O => 'vv',  C => undef }, #
     ee => { O => undef, C => undef },
     ff => {             C => undef },

     gg => { O => 0,     C => 0     },
     hh => { O => undef, C => 0     }, #
     ii => { O => undef             }, #
};

#Only does defined not exists
#98
sub d {$a=pop;grep{$b=$$a{$_};defined$$b{O}!=defined$$b{C}||defined$$b
+{O}&&$$b{O}ne$$b{C}}keys%$a}

#Does defined and exists
#126
sub f {$a=pop;grep{$b=$$a{$_};exists$$b{O}!=exists$$b{C}||defined$$b{O
+}!=defined$$b{C}||defined$$b{O}&&$$b{O}ne$$b{C}}keys%$a}

# [tadman]s original solution compressed
#162
sub t {my($h)=@_;grep{!exists($h->{$_}->{O})||(defined($h->{$_}->{O})?
+(defined($h->{$_}->{C})?($h->{$_}->{O} ne $h->{$_}->{C}):1):defined($
+h->{$_}->{C}))}keys%$h}


print "d():\n",join("\n",sort {$a cmp $b}d($foo)),"\n\n";
print "f():\n",join("\n",sort {$a cmp $b}f($foo)),"\n\n";
print "t():\n",join("\n",sort {$a cmp $b}t($foo)),"\n\n";

__END__
d():
aa
cc
dd
hh

f():
aa
cc
dd
ff
hh
ii

t():
aa
cc
dd
ff
hh
[download]

--- demerphq
my friends call me, usually because I'm late....

I didn't attempt to cater for your test ii because it was not part of the original specs. tadman said.

As a note, the 'new' value is always present, even if it is undef.

If I remove all whitespace and newlines, redundant ;'s etc from my solution above it comes out to 87

sub f{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->
+{$_}{C}}keys%$a} #87
[download]

Then I noticed that I could save a couple more whilst still retaining a 'safe' function (ie. doesn't stomp on any globals) by switch to mying $a for 85

sub g{local$^W=0;my$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->{$
+_}{C}}keys%$a} #85
[download]

but I go the whole hog and abandon safety completely, this can be reduced further (and neatly, below the traditional 80 char line) to 78....

sub h{$^W=0;$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->{$_}{C}}k
+eys%$a} #78
[download]

---

Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!

I didn't attempt to cater for your test ii because it was not part of the original specs.

Hmm, my apologies, I seem to be a bit myopic tonight. I didnt notice that comment. So tadmans solution pases under the rule change.

Still under my test scenario (the 'ii' case removed) all of your solutions generate warnings and fail. Sorry.

use warnings;
use strict;
use Carp;
local $SIG{__WARN__}=sub {die("\t@{[(caller(1))[3]]}() generated warni
+ngs!\n")};

my $foo = {
     aa => { O => 'zz',  C => 'yy'  }, #
     bb => { O => 'xx',  C => 'xx'  },
     cc => { O => undef, C => 'ww'  }, #
     dd => { O => 'vv',  C => undef }, #
     ee => { O => undef, C => undef },
     ff => {             C => undef },
     gg => { O => 0,     C => 0     },
     hh => { O => undef, C => 0     }, #
     #ii => { O => undef             }, # commented out because of rul
+es .
     jj => { O => 0,     C => ' '   }, #
     kk => { O => ' ',   C => 0     }, #
     ll => { O => undef, C => ' '   }, #
     mm => { O => ' ',   C => undef }, #
};

sub BUK{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a
+->{$_}{C}}keys%$a}
sub snw{no warnings qw(uninitialized);my$h=pop;grep{$h->{$_}{O}ne$h->{
+$_}{C}}keys %$h}
sub sg_{my$h=pop;grep{!(defined($h->{$_}{O}&&$h->{$_}{C})&&$h->{$_}{O}
+eq$h->{$_}{C}||!defined($h->{$_}{O}||$h->{$_}{C}))}%$h}
sub eg_{my$h=pop;grep{!(($h->{$_}{O}||$;)eq($h->{$_}{C}||$;))}%$h}
sub ddf{$a=pop;grep{$b=$$a{$_};defined$$b{O}!=defined$$b{C}||defined$$
+b{O}&&$$b{O}ne$$b{C}}keys%$a}#98
sub dex{$a=pop;grep{$b=$$a{$_};exists$$b{O}!=exists$$b{C}||defined$$b{
+O}!=defined$$b{C}||defined$$b{O}&&$$b{O}ne$$b{C}}keys%$a}#126
sub tad{my($h)=@_;grep{!exists($h->{$_}->{O})||(defined($h->{$_}->{O})
+?(defined($h->{$_}->{C})?($h->{$_}->{O}ne$h->{$_}->{C}):1):defined($h
+->{$_}->{C}))}keys%$h}#162
sub ukg{local$^W=0;my$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->
+{$_}{C}}keys%$a} #85
sub ukf{local($^W,$a)=(0,pop);grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a
+->{$_}{C}}keys%$a} #87
sub ukh{$^W=0;$a=pop;grep{!exists$a->{$_}{O}or$a->{$_}{O}ne$a->{$_}{C}
+}keys%$a}

print "      Required: aa cc dd ff hh jj kk ll mm\n";
print "------------------------------------------\n";
eval { print "   tadman golf: @{[sort {$a cmp $b} tad($foo)]}\n"; };
print $@ if $@;

eval { print "BrowserUK golf: @{[sort {$a cmp $b} BUK($foo)]}\n"; };
print $@ if $@;

eval { print "sauoq No warns: @{[sort {$a cmp $b} snw($foo)]}\n"; };
print $@ if $@;

eval { print "    Sauoq golf: @{[sort {$a cmp $b} sg_($foo)]}\n"; };
print $@ if $@;

eval { print "  Elusion golf: @{[sort {$a cmp $b} eg_($foo)]}\n"; };
print $@ if $@;

eval { print " Demerphq defd: @{[sort {$a cmp $b} ddf($foo)]}\n"; };
print $@ if $@;

eval { print "Demerphq exist: @{[sort {$a cmp $b} dex($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk f(): @{[sort {$a cmp $b} ukf($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk g(): @{[sort {$a cmp $b} ukg($foo)]}\n"; };
print $@ if $@;

eval { print " browserUk h(): @{[sort {$a cmp $b} ukh($foo)]}\n"; };
print $@ if $@;

__END__
      Required: aa cc dd ff hh jj kk ll mm
---------------------------------------------
   tadman golf: aa cc dd ff hh jj kk ll mm
    main::BUK() generated warnings!
sauoq No warns: aa cc dd hh jj kk ll mm
    Sauoq golf: aa cc dd hh jj kk ll mm
  Elusion golf: aa cc dd jj kk ll mm
 Demerphq defd: aa cc dd hh jj kk ll mm
Demerphq exist: aa cc dd ff hh jj kk ll mm
    main::ukf() generated warnings!
    main::ukg() generated warnings!
    main::ukh() generated warnings!
[download]

---
demerphq
my friends call me, usually because I'm late....