From db969aff8709f53ce4c7494166feb308008264e0 Mon Sep 17 00:00:00 2001 From: David Baird Date: Mon, 3 Oct 2005 18:36:20 +0000 Subject: [PATCH] Removed last direct accesses to hash keys. Broke out some code into a couple of extra methods for clarity. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@384 48953598-375a-da11-a14b-00016c27c3ee --- lib/Maypole.pm | 177 ++++++++++++++++++++++++++++++------------------- 1 file changed, 109 insertions(+), 68 deletions(-) diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 73c9e75..bc4a5aa 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -35,8 +35,8 @@ sub setup $config->model || $config->model('Maypole::Model::CDBI'); - $config->model->require or die - "Couldn't load the model class $config->{model}: $@"; + $config->model->require or die sprintf + "Couldn't load the model class %s: %s", $config->model, $@; $config->model->setup_database($config, $calling_class, @_); @@ -85,9 +85,13 @@ sub handler : method $r->get_request($req); - $r->parse_location(); + $r->parse_location; - my $status = $r->handler_guts(); + my $status = $r->handler_guts; + + # moving this here causes unit test failures - need to check why + # before committing the move + #$status = $r->__call_process_view unless $r->output; return $status unless $status == OK; @@ -103,20 +107,10 @@ sub handler_guts $r->__load_model; - my $applicable = $r->is_applicable; + my $applicable = __to_boolean $r->is_applicable; + + $r->__setup_plain_template unless $applicable; - unless ( $applicable == OK ) - { - # It's just a plain template - $r->model_class(undef); - - my $path = $r->path; - $path =~ s{/$}{}; # De-absolutify - $r->path($path); - - $r->template($r->path); - } - # We authenticate every request, needed for proper session management my $status; @@ -144,13 +138,14 @@ sub handler_guts # We run additional_data for every request $r->additional_data; - if ( $applicable == OK ) + if ($applicable) { eval { $r->model_class->process($r) }; if ( my $error = $@ ) { $status = $r->call_exception($error); + if ( $status != OK ) { warn "caught model error: $error"; @@ -166,6 +161,25 @@ sub handler_guts return $r->__call_process_view; } +# is_applicable() returned false, so set up a plain template. Model processing +# will be skipped, but need to remove the model anyway so the template can't +# access it. +sub __setup_plain_template +{ + my ($r) = @_; + + # It's just a plain template + $r->model_class(undef); + + my $path = $r->path; + $path =~ s{/$}{}; # De-absolutify + $r->path($path); + + $r->template($r->path); +} + +# The model has been processed or skipped (if is_applicable returned false), +# any exceptions have been handled, and there's no content in $r->output sub __call_process_view { my ($r) = @_; @@ -194,48 +208,72 @@ sub __load_model $r->model_class( $r->config->model->class_of($r, $r->table) ); } -sub is_applicable { - my $self = shift; - my $config = $self->config; +# is_applicable() should return true or false, not OK or DECLINED, because +# the return value is never used as the return value from handler(). There's +# probably a lot of code out there supplying the return codes though, so instead +# of changing is_applicable() to return 0 or 1, the return value is passed through +# __to_boolean. I think it helps handler_guts() if we don't have multiple sets of +# return codes being checked for different things. +sub is_applicable +{ + my ($r) = @_; + + my $config = $r->config; + $config->ok_tables || $config->ok_tables( $config->display_tables ); + $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } ) if ref $config->ok_tables eq "ARRAY"; - warn "We don't have that table ($self->{table}).\n" + + my $table = $r->table; + + warn "We don't have that table ($table).\n" . "Available tables are: " - . join( ",", @{ $config->{display_tables} } ) - if $self->debug - and not $config->ok_tables->{ $self->{table} } - and $self->{action}; - return DECLINED() unless exists $config->ok_tables->{ $self->{table} }; + . join( ",", @{ $config->display_tables } ) + if $r->debug + and not $config->ok_tables->{$table} + and $r->action; # I think this is always true + + return DECLINED unless exists $config->ok_tables->{$table}; # Is it public? - return DECLINED unless $self->model_class->is_public( $self->{action} ); - return OK(); + return DECLINED unless $r->model_class->is_public( $r->action ); + + return OK; } -sub call_authenticate { - my $self = shift; +# *only* intended for translating the return code from is_applicable() +sub __to_boolean ($) { $_[0] == OK ? 1 : 0 } + + + +sub call_authenticate +{ + my ($r) = @_; # Check if we have a model class - if ( $self->{model_class} ) { - return $self->model_class->authenticate($self) - if $self->model_class->can("authenticate"); - } - return $self->authenticate($self); # Interface consistency is a Good Thing + return $r->model_class->authenticate($r) + if $r->model_class + and $r->model_class->can('authenticate'); + + # passing $r is unnecessary and redundant, but there's probably + # a lot of code out there now using the 2nd instead of the 1st $r, + # so we may as well leave it + return $r->authenticate($r); } -sub call_exception { - my $self = shift; - my ($error) = @_; +sub call_exception +{ + my ($r, $error) = @_; # Check if we have a model class - if ( $self->{model_class} - && $self->model_class->can('exception') ) + if ( $r->model_class && $r->model_class->can('exception') ) { - my $status = $self->model_class->exception( $self, $error ); + my $status = $r->model_class->exception( $r, $error ); return $status if $status == OK; } - return $self->exception($error); + + return $r->exception($error); } sub additional_data { } @@ -244,35 +282,38 @@ sub authenticate { return OK } sub exception { return ERROR } -sub parse_path { - my $self = shift; - $self->{path} ||= "frontpage"; - my @pi = $self->{path} =~ m{([^/]+)/?}g; - $self->{table} = shift @pi; - $self->{action} = shift @pi; - $self->{action} ||= "index"; - $self->{args} = \@pi; +sub parse_path +{ + my ($r) = @_; + + $r->path || $r->path('frontpage'); + + my @pi = grep {length} split '/', $r->path; + + $r->table(shift @pi); + + $r->action( shift @pi or 'index' ); + + $r->args(\@pi); } -sub param { # like CGI::param(), but read-only - my $r = shift; - my ($key) = @_; - if (defined $key) { - unless (exists $r->{params}{$key}) { - return wantarray() ? () : undef; - } - my $val = $r->{params}{$key}; - if (wantarray()) { - return ref $val ? @$val : $val; - } else { - return ref $val ? $val->[0] : $val; - } - } else { - return keys %{$r->{params}}; - } +# like CGI::param(), but read only +sub param +{ + my ($r, $key) = @_; + + return keys %{$r->params} unless defined $key; + + return unless exists $r->params->{$key}; + + my $val = $r->params->{$key}; + + return ref $val ? @$val : ($val) if wantarray; + + return ref $val ? $val->[0] : $val; } -sub get_template_root { "." } +sub get_template_root {'.'} sub get_request { } sub parse_location { -- 2.39.5