Can this Perl behaviour be emulated with a switch/case or given/when?

Question

I was wondering if anyone had any suggestions on improving the following code (if possible) so that it didn't need the repeated (my @a = $time =~ ...), possibly using case/switch or given/when or some other idea that i'm missing?

my $time = '12:59pm';

if( my @a = $time =~ m/^(\d\d?)(am|pm)$/ )        { tell_time( $a[0], 0, $a[1] ) }
if( my @a = $time =~ m/^(\d\d?):(\d\d)(am|pm)$/ ) { tell_time( @a ) }
if( my @a = $time =~ m/^(\d\d?):(\d\d)$/ )        { tell_time( @a ) }

sub tell_time
{
    my $hour    = shift;
    my $minute  = shift || '00';
    my $ampm    = shift || ( $hour > 12 ) ? 'pm' : 'am';

    print "Hour: $hour, Minute: $minute, AMPM: $ampm\n";
}

I've tried playing around with Switch and the 5.10 given/when but can't seem to be able to do something like:

given( $time )
{
    when( /^(\d\d?)(am|pm)$/ )        { tell_time( $_[0], 0, $_[1] ) }
    when( /^(\d\d?):(\d\d)(am|pm)$/ ) { tell_time( @_ ) }
    when( /^(\d\d?):(\d\d)$/ )        { tell_time( @_ ) }
}

That doesn't fly because @_ appears to be storing $time.

also note I'm more interested in the syntax of the problem than the problem the code solves. I'm well aware that I could use Time::ParseDate to figure out the various parts of a string formatted like a time or date.

Answer 1

Your regex uses () to extract matches, but you don't have to store these in an array. If you want, they're stored in $1, $2, $3, and so on. Lookie:

given( $time )
{
    when( /^(\d\d?)(am|pm)$/ )        { tell_time( $1, 0, $2 ) }
    when( /^(\d\d?):(\d\d)(am|pm)$/ ) { tell_time( $1, $2, $3 ) }
    when( /^(\d\d?):(\d\d)$/ )        { tell_time( $1, $2 ) }
}

Does exactly what I think you want to do.

If you want to add to the syntax, I would write tell_time() to simply take the time as a string, and have the function parse the result itself, rather than make the user of your code parse it himself. Alternatively, you could use this given() block as the start of a new function that does exactly that - parses a time string and passes it correctly to tell_time(). But that's just me. I don't know what you need your code to do, so by all means go for it.

Answer 2

Well, without using switch/case, I'd just use a single regex to capture all the variations...

#!/usr/bin/perl

tell_time ("12:59am");    # matches time format 1
tell_time ("2:59pm");     # matches time format 1
tell_time ("12am");       # matches time format 2
tell_time ("12:59");      # matches time format 3
tell_time ("14:59");      # matches time format 3
tell_time ("12:59:59am"); # produces no output, does not match any known time formats.

sub tell_time
{
    my $timearg = shift;

    # note: (?: ... ) creates a non-capturing group, which is not reflected in 
    # the returned array.
    my ($hour , $minute, $ampm) = ( $timearg =~ m/^(\d\d?)(?::(\d\d?))?(am|pm)?$/ ) ;

    # only continue if we captured all required fields (i.e. hour)
    if($hour)
    {
        # set default values for optional fields (i.e. minute, ampm) if necessary
        $minute ||=  '00';
        $ampm ||=  ( $hour > 12 ) ? 'pm' : 'am';

        print "Hour: $hour, Minute: $minute, AMPM: $ampm\n";
    }

}

I can explain it further if necessary, but I think if you can read perl it should be clear what it's doing...

Answer 3

Chris Lutz already covered the switch syntax using Perl 5.10. In order versions of Perl you can use loop aliasing to emulate one:

for ($time) {
  /^(\d\d?)(am|pm)$/        && do { tell_time( $1, 0, $2 );  last };
  /^(\d\d?):(\d\d)(am|pm)$/ && do { tell_time( $1, $2, $3 ); last };
  /^(\d\d?):(\d\d)$/        && do { tell_time( $1, $2 );     last };
}

Answer 4

Since you are using 5.10, you might as well use named captures in your regex:

#!/usr/bin/perl

use 5.010;
use strict;
use warnings;

my $hour24   = qr/(?<hour>[1-9]|1[0-9]|2[0-3])/;
my $hour12   = qr/(?<hour>[1-9]|1[0-2])/;
my $minute   = qr/(?<minute>[0-5][0-9])/;
my $meridiem = qr/(?<meridiem>am|AM|pm|PM)/;

for my $time (qw(5pm 10am 5:59pm 10:00pm 5:00 22:00 24:00)) {
    given($time) {
     when(/ ^ $hour12 $meridiem $ /x) { 
      my $hour = $+{hour};
      $hour += 12 if 'pm' eq lc $+{meridiem};
      tell_time($hour, "00") 
     }
     when(/ ^ $hour12 : $minute $meridiem $ /x) { 
      my $hour = $+{hour};
      $hour += 12 if 'pm' eq lc $+{meridiem};
      tell_time($hour, $+{minute}) 
     }
     when(/ ^ $hour24 : $minute $ /x) { 
      tell_time($+{hour}, $+{minute}) 
     }
     default {
      say "bad time: $time";
     }
    }
}

sub tell_time {
    my ($hour, $minute) = @_;
    say "it is $hour:$minute";
}

Answer 5

I am not sure if the given/when aspect is important here. I would just combine the possible patterns in a single regex. Combined with the special variable %+ and the defined-or operator, we can make the code more succinct.

#!/usr/bin/perl

use strict;
use warnings;

my @times = qw( 12:59pm 12 1pm 13:11 11 11pm);

my $hour_pat   = '(?<hour>[0-9]{1,2})';
my $minute_pat = '(?<minute>[0-9]{2})';
my $ampm_pat   = '(?<ampm>am|pm)';

my $re = qr{
    \A
    (?:$hour_pat : $minute_pat $ampm_pat)
    |
    (?:$hour_pat : $minute_pat)
    |
    (?:$hour_pat $ampm_pat)
    |
    (?:$hour_pat)
    \z
}x;

for my $time ( @times ) {
    if ( $time =~ $re ) {
        tell_time( %+ );
    }
}

sub tell_time {
    my %time = @_;
    printf( "Hour: %2.2d, Minute: %2.2d, AMPM: %s\n",
        $time{hour},
        $time{minute} // 0,
        $time{ampm} // ( $time{hour} >= 12 ? 'pm' : 'am' ),
    );
    return;
}

Answer 6

I create switch with a block label, like this:

my $time = '12:59pm';
SWITCH: {
    $time =~ /^(\d\d?)(am|pm)$/ && do { 
     tell_time($1,0,$2);
     last SWITCH;
    };
    $time =~ /^(\d\d?):(\d\d)(am|pm)$/ && do {
     tell_time($1,$2,$3);
     last SWITCH;
    };
    $time =~ /^(\d\d?):(\d\d)$/ && do {
     tell_time($1,$2);
    };
}