fork download
copy 
  1. #!/usr/bin/perl
  2.  
  3. # Idiom #313 Map equality
  4.  
  5. use strict;
  6. use warnings;
  7.  
  8. sub hcmp_numeric {
  9.     my ($h, $g) = @_;
  10.  
  11.     my $hc = keys %$h;
  12.     my $gc = keys %$g;
  13.  
  14.     return 0 unless $hc == $gc;
  15.     return 0 unless $hc == grep { exists $g->{$_} } keys %$h;
  16.     die 'non-scalar value detected' 
  17.         if 0 < grep { ref $h->{$_} or ref $g->{$_} } keys %$h;
  18.     return 0 unless $hc == grep { $h->{$_} == $g->{$_} } keys %$h;
  19.     return 1;
  20. }
  21.  
  22. my $a = { A => 1, B => 2, C => 3 };
  23. my $b = { A => 1, B => 2, C => 3, D => 4 };
  24. my $c = { A => 1, B => 2, C => 99 };
  25. my $d = { A => 1, xBx => 2, C => 3 };
  26. my $e = { A => 1 };
  27. my $f = { };
  28.  
  29. print 'hcmp(a,a): ', hcmp_numeric( $a, $a ) ? 'matched' : 'not matched', "\n";
  30. print 'hcmp(a,b): ', hcmp_numeric( $a, $b ) ? 'matched' : 'not matched', "\n";
  31. print 'hcmp(a,c): ', hcmp_numeric( $a, $c ) ? 'matched' : 'not matched', "\n";
  32. print 'hcmp(a,d): ', hcmp_numeric( $a, $d ) ? 'matched' : 'not matched', "\n";
  33. print 'hcmp(a,e): ', hcmp_numeric( $a, $e ) ? 'matched' : 'not matched', "\n";
  34. print 'hcmp(a,f): ', hcmp_numeric( $a, $f ) ? 'matched' : 'not matched', "\n";
  35. print 'hcmp(f,f): ', hcmp_numeric( $f, $f ) ? 'matched' : 'not matched', "\n";
  36.  
  37. use Try::Tiny;
  38.  
  39. my $x = { A => 1, B => 2 , C => 3 };
  40. my $y = { A => 1, B => [], C => 3 };
  41.  
  42. try {
  43.     print 'hcmp(x,y): ', hcmp_numeric( $x, $y ) ? 'matched' : 'not matched', "\n";
  44. } catch {
  45.     print $_;
  46. };
  47.  
  48. try {
  49.     print 'hcmp(y,x): ', hcmp_numeric( $y, $x ) ? 'matched' : 'not matched', "\n";
  50. } catch {
  51.     print $_;
  52. };
  53.  
  54. try {
  55.     print 'hcmp(y,y): ', hcmp_numeric( $y, $y ) ? 'matched' : 'not matched', "\n";
  56. } catch {
  57.     print $_;
  58. };
  59.  
Success #stdin #stdout 0.02s 6328KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
hcmp(a,a): matched
hcmp(a,b): not matched
hcmp(a,c): not matched
hcmp(a,d): not matched
hcmp(a,e): not matched
hcmp(a,f): not matched
hcmp(f,f): matched
non-scalar value detected at prog.pl line 17.
non-scalar value detected at prog.pl line 17.
non-scalar value detected at prog.pl line 17.
https://ideone.com/qVgwmG
Idiom #313 Map equality
language:
Perl (perl 5.28.1)
created:
1 year ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!