From: David Baird Date: Tue, 4 Oct 2005 11:13:54 +0000 (+0000) Subject: Changed to throughout Maypole.pm. X-Git-Tag: 2.11~131 X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=808f88dcc99bd004c98cbefb759da90512da58eb;p=maypole.git Changed to throughout Maypole.pm. Removed a few newlines, but finding it a hard habit to break! Added Maypole::new() constructor. Limited lines to 80 characters. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@387 48953598-375a-da11-a14b-00016c27c3ee --- diff --git a/lib/Maypole.pm b/lib/Maypole.pm index ad39125..908662f 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -11,7 +11,8 @@ our $VERSION = '2.10'; # proposed privacy conventions: # - no leading underscore - public to custom application code and plugins -# - single leading underscore - private to the main Maypole stack - *not* including plugins +# - single leading underscore - private to the main Maypole stack - *not* +# including plugins # - double leading underscore - private to the current package __PACKAGE__->mk_classdata($_) for qw( config init_done view_object ); @@ -63,6 +64,18 @@ sub init } +sub new +{ + my ($class) = @_; + + my $self = bless { + template_args => {}, + config => $class->config, + }, $class; + + return $self; +} + # handler() has a method attribute so that mod_perl will invoke # BeerDB->handler() as a method rather than a plain function # BeerDB::handler() and so this inherited implementation will be @@ -75,27 +88,22 @@ sub handler : method $class->init unless $class->init_done; - # Create the request object - my $r = bless { - template_args => {}, - config => $class->config - }, $class; - - $r->headers_out(Maypole::Headers->new); + my $self = $class->new; - $r->get_request($req); + # initialise the request + $self->headers_out(Maypole::Headers->new); + $self->get_request($req); + $self->parse_location; - $r->parse_location; - - my $status = $r->handler_guts; + my $status = $self->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; + #$status = $self->__call_process_view unless $self->output; return $status unless $status == OK; - $r->send_output; + $self->send_output; return $status; } @@ -103,62 +111,64 @@ sub handler : method # The root of all evil sub handler_guts { - my ($r) = @_; + my ($self) = @_; - $r->__load_model; + $self->__load_model; - my $applicable = __to_boolean( $r->is_applicable ); + my $applicable = __to_boolean( $self->is_applicable ); - $r->__setup_plain_template unless $applicable; + $self->__setup_plain_template unless $applicable; # We authenticate every request, needed for proper session management my $status; - eval { $status = $r->call_authenticate }; + eval { $status = $self->call_authenticate }; if ( my $error = $@ ) { - $status = $r->call_exception($error); + $status = $self->call_exception($error); if ( $status != OK ) { warn "caught authenticate error: $error"; - return $r->debug ? $r->view_object->error($r, $error) : ERROR; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } } - if ( $r->debug and $status != OK and $status != DECLINED ) + if ( $self->debug and $status != OK and $status != DECLINED ) { - $r->view_object->error( $r, + $self->view_object->error( $self, "Got unexpected status $status from calling authentication" ); } return $status unless $status == OK; # We run additional_data for every request - $r->additional_data; + $self->additional_data; if ($applicable) { - eval { $r->model_class->process($r) }; + eval { $self->model_class->process($self) }; if ( my $error = $@ ) { - $status = $r->call_exception($error); + $status = $self->call_exception($error); if ( $status != OK ) { warn "caught model error: $error"; - return $r->debug ? $r->view_object->error($r, $error) : ERROR; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } } } - # unusual path - perhaps output has been set to an error message - return OK if $r->output; + # less frequent path - perhaps output has been set to an error message + return OK if $self->output; # normal path - no output has been generated yet - return $r->__call_process_view; + return $self->__call_process_view; } # is_applicable() returned false, so set up a plain template. Model processing @@ -166,36 +176,37 @@ sub handler_guts # access it. sub __setup_plain_template { - my ($r) = @_; + my ($self) = @_; # It's just a plain template - $r->model_class(undef); + $self->model_class(undef); - my $path = $r->path; + my $path = $self->path; $path =~ s{/$}{}; # De-absolutify - $r->path($path); + $self->path($path); - $r->template($r->path); + $self->template($self->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 +# any exceptions have been handled, and there's no content in $self->output sub __call_process_view { - my ($r) = @_; + my ($self) = @_; my $status; - eval { $status = $r->view_object->process($r) }; + eval { $status = $self->view_object->process($self) }; if ( my $error = $@ ) { - $status = $r->call_exception($error); + $status = $self->call_exception($error); if ( $status != OK ) { - warn "caught view error: $error" if $r->debug; - return $r->debug ? $r->view_object->error($r, $error) : ERROR; + warn "caught view error: $error" if $self->debug; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } } @@ -204,40 +215,40 @@ sub __call_process_view sub __load_model { - my ($r) = @_; - $r->model_class( $r->config->model->class_of($r, $r->table) ); + my ($self) = @_; + $self->model_class( $self->config->model->class_of($self, $self->table) ); } # 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. +# 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 -drb. sub is_applicable { - my ($r) = @_; + my ($self) = @_; - my $config = $r->config; + my $config = $self->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"; + if ref $config->ok_tables eq "ARRAY"; - my $table = $r->table; + my $table = $self->table; warn "We don't have that table ($table).\n" - . "Available tables are: " - . join( ",", @{ $config->display_tables } ) - if $r->debug + . "Available tables are: " + . join( ",", @{ $config->display_tables } ) + if $self->debug and not $config->ok_tables->{$table} - and $r->action; # I think this is always true + and $self->action; # this is probably always true return DECLINED unless exists $config->ok_tables->{$table}; # Is it public? - return DECLINED unless $r->model_class->is_public( $r->action ); + return DECLINED unless $self->model_class->is_public($self->action); return OK; } @@ -245,34 +256,33 @@ sub is_applicable # *only* intended for translating the return code from is_applicable() sub __to_boolean { $_[0] == OK ? 1 : 0 } - - sub call_authenticate { - my ($r) = @_; + my ($self) = @_; - # Check if we have a model class - return $r->model_class->authenticate($r) - if $r->model_class - and $r->model_class->can('authenticate'); + # Check if we have a model class with an authenticate() to delegate to + return $self->model_class->authenticate($self) + if $self->model_class and $self->model_class->can('authenticate'); - # if the driver ($r) and the request ($r) ever get separated out - # properly, then passing the request as an argument will make more sense - return $r->authenticate($r); + # Interface consistency is a Good Thing - + # the invocant and the argument may one day be different things + # (i.e. controller and request), like they are when authenticate() + # is called on a model class (i.e. model and request) + return $self->authenticate($self); } sub call_exception { - my ($r, $error) = @_; + my ($self, $error) = @_; - # Check if we have a model class - if ( $r->model_class && $r->model_class->can('exception') ) + # Check if we have a model class with an exception() to delegate to + if ( $self->model_class && $self->model_class->can('exception') ) { - my $status = $r->model_class->exception( $r, $error ); + my $status = $self->model_class->exception( $self, $error ); return $status if $status == OK; } - return $r->exception($error); + return $self->exception($error); } sub additional_data { } @@ -283,29 +293,29 @@ sub exception { return ERROR } sub parse_path { - my ($r) = @_; + my ($self) = @_; - $r->path || $r->path('frontpage'); + $self->path || $self->path('frontpage'); - my @pi = grep {length} split '/', $r->path; + my @pi = grep {length} split '/', $self->path; - $r->table(shift @pi); + $self->table(shift @pi); - $r->action( shift @pi or 'index' ); + $self->action( shift @pi or 'index' ); - $r->args(\@pi); + $self->args(\@pi); } # like CGI::param(), but read only sub param { - my ($r, $key) = @_; + my ($self, $key) = @_; - return keys %{$r->params} unless defined $key; + return keys %{$self->params} unless defined $key; - return unless exists $r->params->{$key}; + return unless exists $self->params->{$key}; - my $val = $r->params->{$key}; + my $val = $self->params->{$key}; return ref $val ? @$val : ($val) if wantarray; @@ -376,6 +386,10 @@ You should not call this directly, but you may wish to override this to add application-specific initialisation. +=head3 new + +Constructs a very minimal new Maypole request object. + =head3 view_object Get/set the Maypole::View object @@ -475,9 +489,9 @@ or CGI request object, it defaults to blank. Returns a Maypole::Constant to indicate whether the request is valid. -The default implementation checks that C<$r-Etable> is publicly +The default implementation checks that C<$self-Etable> is publicly accessible -and that the model class is configured to handle the C<$r-Eaction> +and that the model class is configured to handle the C<$self-Eaction> =head3 authenticate @@ -505,7 +519,7 @@ Get/set a list of model objects. The objects will be accessible in the view templates. -If the first item in C<$r-Eargs> can be Cd by the model +If the first item in C<$self-Eargs> can be Cd by the model class, it will be removed from C and the retrieved object will be added to the @@ -513,14 +527,14 @@ C list. See L for more information. =head3 template_args - $r->template_args->{foo} = 'bar'; + $self->template_args->{foo} = 'bar'; Get/set a hash of template variables. =head3 template Get/set the template to be used by the view. By default, it returns -C<$r-Eaction> +C<$self-Eaction> =head3 exception @@ -574,7 +588,8 @@ exception method of your Maypole application. =head3 make_random_id -returns a unique id for this request can be used to prevent or detect repeat submissions. +returns a unique id for this request can be used to prevent or detect repeat +submissions. =head3 handler