refactoring CGI::App for Perl6:'given' as a switch statement

markjugg on 2006-08-17T01:52:06

I'm porting CGI::Application to Perl6 as a way to learn about Perl6. I'm going to share some of these "real world" refactors here to demonstrate some Perl6 features.

Before:
We have a a typical Perl5 if/else chain. The dangling "if" and "die" and at the end should have really be part of the chain, but I did say this was real-world code...

sub _send_headers {
    my $self = shift;
    my $q = $self->query();

    my $header_type = $self->header_type();

    if ($header_type eq 'redirect') {
        return $q->redirect($self->header_props());
    } elsif ($header_type eq 'header' ) {
        return $q->header($self->header_props());
    }

    # croak() if we have an unknown header type
    croak ("Invalid header_type '$header_type'") unless ($header_type eq "none");

    # Do nothing if header type eq "none".
    return "";
}

After:
Of course, "my $self = shift" is gone, (Wahoo!), but notice now the new 'given' switch statement cleans things up nicely:

method _send_headers {
    my $q = self.query;
    given self.header_type {
        when 'redirect' { return $q.redirect(self.header_props)      }
        when 'header'   { return $q.header(self.header_props)        }
        when 'none'     { return ""                                  }
        default         { die "Invalid header_type '$header_type'" }
    }
}

In total: 18 lines reduced to 9, with a clarity gained!

---

A Perl5 refactoring

ChrisDolan on 2006-08-17T02:29:34

Here's a way to refactor the code legibly in Perl5 without 'given':


        sub _send_headers {
                my $self = shift;
                my $q = $self->query();

                my $header_type = $self->header_type();

                return
                      $header_type eq 'redirect' ? $q->redirect($self->header_props())
                    : $header_type eq 'header' ? $q->header($self->header_props())
                    : $header_type eq 'none' ? ''
                    : croak("Invalid header_type '$header_type'")
        }


Re:A Perl5 refactoring (winner!)

markjugg on 2006-08-17T13:04:54

Thanks Chris, I like this refactor the best.

I commited a variation of this to the CGI::Application p5 source tree.

Re:A Perl5 refactoring (winner!)

ChrisDolan on 2006-08-17T14:17:46

Thank Damian Conway. I picked up this hanging ternary style of indentation from his "Perl Best Practices" book. I use it instead of if/elsif/else whenever possible now.

More perl 5 refactoring

xanthippe on 2006-08-17T04:22:41

sub send_headers {
    my $self = shift;
    my $q = $self->query;
    my %actions = ( redirect  => sub { $q->redirect( $self->header_props ) },
                    header    => sub { $q->header($self->header_props()) },
                    none      => sub { return '' },
                    _default_ => sub { croak "Invalid header_type " . $self->$header_type } );

    return $actions{ $self->header_type || '_default_' }->();
}

Re:More perl 5 refactoring

reneeb on 2006-08-17T06:34:15

That's not correct in detail. The _default_ action will be executed if the headertype is undef or 0, but what about "illegal" headertypes - e.g. 'foo' ?

This would be better:

sub send_headers { my $self = shift; my $q = $self->query; my %actions = ( redirect => sub { $q->redirect( $self->header_props ) }, header => sub { $q->header($self->header_props()) }, none => sub { return '' }, _default_ => sub { croak "Invalid header_type " . $self->$header_type } );

my $headertype = exists $actions{$self->header_type} ? $self->header_type : '_default_'; return $actions{ $headertype }->(); }

Re:More perl 5 refactoring

reneeb on 2006-08-17T06:37:14

Sorry, pushed the wrong button...

sub send_headers {
    my $self = shift;
    my $q = $self->query;
    my %actions = (
            redirect     => sub { $q->redirect( $self->header_props ) },
            header       => sub { $q->header($self->header_props()) },
            none         => sub { return '' },
            _default_    => sub { croak "Invalid header_type " . $self->$header_type } );

    my $headertype = exists $actions{$self->header_type} ? $self->header_type : '_default_';
    return $actions{ $headertype }->();
}