The map trap. Run this:

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

my %oops=(
    A => 1,
    map { $_ => 2 } ('B','C'),
    map { $_ => 3 } ('D','E'),
    F => 4,
);

print Dumper(\%oops);
[download]

Look at the output. Then add ( ) around each map expression:

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

my %oops=(
    A => 1,
    (map { $_ => 2 } ('B','C')),
    (map { $_ => 3 } ('D','E')),
    F => 4,
);

print Dumper(\%oops);
[download]

Alexander

Bless you!

I thought the technique itself should be sound, and the solution something simple, but I didn't realize it would be this simple!

Thanks!

HTH,

planetscape

No need to double up on the parentheses

    (map { $_ => 2 } 'B','C'),
    (map { $_ => 3 } 'D','E'),
[download]

But isn't this always the case when you're dealing with statements that take lists as arguments?

# Ooops!
print join ",", @foo, "\n";

# Ooops!
print grep /o/, @foo, "Hello world!\n";

# Ooops!
print table{
    map {
        tr(td($_->[0]), td($_->[1])) } @foo,
        ...
[download]

My rule of thumb is, if one of these statements is followed by anything besides its argument, then parenthesize that statement's entire argument list.

# De-oopsed.
print join(",", @foo), "\n";
print grep(/o/, @foo), "Hello world!\n";
print table{
    map({
        tr(td($_->[0]), td($_->[1])) } @foo),
        ...
[download]

-- 
I hate storms, but calms undermine my spirits.
 -- Bernard Moitessier, "The Long Way"

use strict;

{
   package Dispatch::Table;
   use overload
      '&{}' => sub { my $x=shift; sub { $x->lookup($_[0]) } },
      '.'   => sub { (shift)->lookup(shift) },
      '~~'  => sub { (shift)->exists(shift) };
   sub new
   {
      my $class = shift;
      my @self;
      while (@_)
      {
         my ($test, $action) = (shift, shift);
         push @self, [$test => $action];
      }
      bless \@self, $class;
   }
   sub lookup
   {
      my ($self, $value) = @_;
      foreach my $entry (@$self)
      {
         if ($value ~~ $entry->[0])
         {
            return ref $entry->[1] eq 'CODE' ?
               $entry->[1]->($value) :
               $entry->[1];
         }
      }
      return;
   }
   sub exists
   {
      my ($self, $value) = @_;
      foreach my $entry (@$self)
      {
         if ($value ~~ $entry->[0])
         {
            return ref $entry->[1] eq 'CODE' ?
               $entry->[1] :
               sub { $entry->[1] };
         }
      }
      return;
   }
}

sub action_1_to_999 {
   print "1 to 999\n";
}

my $dispatch = Dispatch::Table->new(
   0           => sub { print "Zero\n" },
   [1..10]     => sub { print "Single digit\n"},
   1_000       => sub { print "1e3\n" },
   qr/^\d{4}/  => sub { print "Over a thousand\n"},
   sub { my $x = shift; $x>0 && $x<1000 } => \&action_1_to_999,
);

$dispatch.0;   # call dispatch table on value '0'
$dispatch.3;   # call dispatch table on value '3'
$dispatch.23;  # guess!

# call dispatch table on '999999' but only if the dispatch table
# has an entry that covers value '-1'.
$dispatch.999999 if $dispatch ~~ -1; 

# call dispatch table on '1000' but only if the dispatch table
# has an entry that covers value '4'.
$dispatch.1000 if $dispatch ~~ 4; 
__END__
Zero
Single digit
1 to 999
1e3
[download]

OK, I can go better...

Read more... (4 kB)

use 5.010;
use strict;
use Smart::Dispatch;

sub action_1_to_999 {
   "1 to 999";
}

my $dispatch = dispatcher {
   match 0,
      dispatch { "Zero" };
   match [1..10],
      dispatch { "Single digit" };
   match 1_000,
      dispatch { "1e3" };
   match qr/^\d{4}/,
      dispatch { "Over a thousand\n"};
   match_using { $_ > 0 and $_ < 1000 }
      dispatch \&action_1_to_999;
};

say $dispatch.0;   # call dispatch table on value '0'
say $dispatch.3;   # call dispatch table on value '3'
say $dispatch.23;  # guess!

# call dispatch table on '999999' but only if the dispatch table
# has an entry that covers value '-1'.
say $dispatch.999999 if $dispatch ~~ -1; 

# call dispatch table on '1000' but only if the dispatch table
# has an entry that covers value '4'.
say $dispatch.1000 if $dispatch ~~ 4;
[download]

PS: as you're clearly dealing with UK phone numbers, here's an interesting piece of trivia...

Brighton's STD code is 01273. Back in 1995 nearly all the STD codes in the UK were changed with the insertion of that "1" (e.g. London changed from 071/081 to 0171/0181). So before 1995, Brighton's STD code was 0273.

Notice what letters 2 and 7 represent on a mobile phone keypad? 27 = BR. Apart from a few larger cities that have been renumbered, nearly all STD codes in the UK have a similar heritage. 01323 is Eastbourne; 32=EA. 01444 is Haywards Heath; 44=HH. 01424 is Hastings; 42=HA. They're all derived from telephone exchange names from back before STD was introduced.

I think using given Switch statements gives you much more flexibility, as it uses smart matching and can do lots of clever things. You do have to type a bit more but it's worth it ;)

So something like this :-

use v5.14;
use warnings;


sub ident_number {
  my ($num) = @_;

  given ($num) {
    when ('01') {
      say 'geographic';
    }

    when (/^\d+$/ && $_ >= 124 && $_ <= 140) {
      say '124 - 140';
    }
    when ([143 .. 146, 148 .. 149]) {
      say "$_ other stuff";
    }

    when ([181 ..189]) {
      say '181 -- 189';
    }
    default {
      say "$_ not found";
    }
  }
}


my @tests = qw/ 01 02 125 127 186 500 143 149 189/;

for (@tests) {
  ident_number($_);
}
[download]

My initial attempt was based on given but I switched to using a list of smart matches and subroutines because given has a drawback compared to dispatch tables...

With dispatch tables you can check whether a particular value can dispatch, without actually doing the dispatching yet. If your dispatch table is a hash, then it's just defined($dispatch{$value}).