From: Aaron Trevena Date: Tue, 21 Feb 2006 20:21:24 +0000 (+0000) Subject: fixing bugs introduced in 2.11 X-Git-Tag: 2.11~58 X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=3ed98309a0852fc198f9e4d0e6f70c5510c8282f;p=maypole.git fixing bugs introduced in 2.11 git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@460 48953598-375a-da11-a14b-00016c27c3ee --- diff --git a/Changes b/Changes index 89e02e7..481fc58 100644 --- a/Changes +++ b/Changes @@ -73,6 +73,7 @@ Bug fixes: model search/delete methods in model and subclassing the cdbi mode (bug 16661) fixed problems with stringify_self and untaint missing ignore columns (bug 15678) fixed Maypole::Model::CDBI::Plain to JustWork(TM) with plain CDBI Classes (bug 16977) + some silent death scenarios resolved Documentation: Fix to documentation for CGI::Maypole (bug 7263) diff --git a/Makefile.PL b/Makefile.PL index 7881d36..48dfb15 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -31,6 +31,7 @@ WriteMakefile( Test::MockModule => 0, Digest::MD5 => 0, File::MMagic::XS => 0.08, + Class::DBI::Plugin::Type => 0, }, # e.g., Module::Name => 1.1 ( $] >= 5.005 diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 4633b1f..858c1eb 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -3,6 +3,7 @@ use base qw(Class::Accessor::Fast Class::Data::Inheritable); use UNIVERSAL::require; use strict; use warnings; +use Data::Dumper; use Maypole::Config; use Maypole::Constants; use Maypole::Headers; @@ -254,7 +255,7 @@ Some packages respond to higher debug levels, try increasing it to 2 or 3. =cut -sub debug { 0 } +sub debug { 1 } =item config @@ -444,8 +445,9 @@ sub handler : method { # initialise the request $self->headers_out(Maypole::Headers->new); $self->get_request($req); + $self->parse_location; - + # hook useful for declining static requests e.g. images, or perhaps for # sanitizing request parameters $self->status(Maypole::Constants::OK()); # set the default @@ -459,6 +461,7 @@ sub handler : method { $self->get_user; my $status = $self->handler_guts; + return $status unless $status == OK; # TODO: require send_output to return a status code @@ -558,7 +561,9 @@ sub handler_guts $self->__load_request_model; my $applicable = $self->is_model_applicable == OK; - + + warn "applicable : $applicable"; + $self->__setup_plain_template unless $applicable; my $status; @@ -582,7 +587,7 @@ sub handler_guts $self->view_object->error( $self, "Got unexpected status $status from calling authentication" ); } - + return $status unless $status == OK; # We run additional_data for every request @@ -607,13 +612,21 @@ sub handler_guts # less frequent path - perhaps output has been set to an error message return OK if $self->output; + +# warn "output before processing view : ", $self->output; # normal path - no output has been generated yet my $processed_view_ok = $self->__call_process_view; + warn "output after processing view : ", $self->output; + + warn "error after processing view : ", $self->{error}; + $self->{content_type} ||= $self->__get_mime_type(); $self->{document_encoding} ||= "utf-8"; + warn "made it to end, processed_view_ok : $processed_view_ok"; + return $processed_view_ok; } @@ -626,11 +639,14 @@ my %filetypes = ( sub __get_mime_type { my $self = shift; - my $type; + my $type = 'text/html'; if ($self->path =~ m/.*\.(\w{3,4})$/) { $type = $filetypes{$1}; } else { - $type = $mmagic->checktype_contents($self->output); + my $output = $self->output; + if (defined $output) { + $type = $mmagic->checktype_contents($output); + } } return $type; } @@ -660,27 +676,24 @@ sub __setup_plain_template # The model has been processed or skipped (if is_applicable returned false), # any exceptions have been handled, and there's no content in $self->output -sub __call_process_view -{ - my ($self) = @_; - - my $status; - - eval { $status = $self->view_object->process($self) }; - - if ( my $error = $@ ) - { - $status = $self->call_exception($error, "view"); - - if ( $status != OK ) - { - warn "caught view error: $error" if $self->debug; - return $self->debug ? - $self->view_object->error($self, $error) : ERROR; - } +sub __call_process_view { + my ($self) = @_; + + my $status = eval { $self->view_object->process($self) }; + + my $error = $@ || $self->{error}; + + if ( $error ) { + $status = $self->call_exception($error, "view"); + + if ( $status != OK ) { + warn "caught view error: $error" if $self->debug; + return $self->debug ? + $self->view_object->error($self, $error) : ERROR; } - - return $status; + } + + return $status; } =item get_request @@ -1437,8 +1450,7 @@ L, L, L. =head1 AUTHOR -Maypole is currently maintained by Aaron Trevena, David Baird, Dave Howorth and -Peter Speltz. +Maypole is currently maintained by Aaron Trevena. =head1 AUTHOR EMERITUS diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 3705331..a200fc5 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -26,7 +26,7 @@ will instead use Class::DBI classes provided. use base qw(Maypole::Model::Base Class::DBI); use Maypole::Model::CDBI::AsForm; use CGI::Untaint::Maypole; - +use Class::DBI::Plugin::Type; use Class::DBI::FromCGI; use Class::DBI::Loader; use Class::DBI::AbstractSearch; diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm index 023f88d..3c35dfc 100644 --- a/lib/Maypole/Model/CDBI/AsForm.pm +++ b/lib/Maypole/Model/CDBI/AsForm.pm @@ -543,13 +543,10 @@ sub _to_select { # Get items to select from $args->{items} = _select_items($args); -use Data::Dumper; -warn "Just got items. They are " . Dumper($args->{items}); - - # Make select HTML element - $a = $self->_select_guts($col, $args); + # Make select HTML element + $a = $self->_select_guts($col, $args); - # Return + # Return $OLD_STYLE && return $a->as_HTML; $a; @@ -578,7 +575,6 @@ sub _select_items { $sql .= " WHERE " . $args->{where} if $args->{where}; $sql .= " ORDER BY " . $args->{order_by} if $args->{order_by}; $sql .= " LIMIT " . $args->{limit} if $args->{limit}; -warn "_select_items sql is : $sql"; return $fclass->db_Main->selectall_arrayref($sql); @@ -944,8 +940,7 @@ sub _options_from_arrays { my $content = ($fclass and $stringify and $fclass->can($stringify)) ? $fclass->$stringify($_) : join('/', @{$_}); -use Data::Dumper; -warn "Content is $content"; + $opt->push_content( $content ); push @res, $opt; } @@ -1138,6 +1133,3 @@ L, L, L. =cut - - - diff --git a/lib/Maypole/View/Base.pm b/lib/Maypole/View/Base.pm index ece5d98..a2718c4 100644 --- a/lib/Maypole/View/Base.pm +++ b/lib/Maypole/View/Base.pm @@ -82,16 +82,14 @@ sub process { sub error { my ( $self, $r, $desc ) = @_; $desc = $desc ? "$desc: " : ""; - carp $desc . $r->{error}; if ( $r->{error} =~ /not found$/ ) { - + warn "template not found error : ", $r->{error}; # This is a rough test to see whether or not we're a template or # a static page return -1 unless @{ $r->{objects} || [] }; my $template_error = $r->{error}; $r->{error} = < Template not found A template was not found while processing the following request: @@ -119,9 +117,6 @@ EOF $r->{output} = $r->{error}; return OK; } - $r->{content_type} = "text/plain"; - $r->{output} = $r->{error}; - $r->send_output; return ERROR; } diff --git a/lib/Maypole/View/TT.pm b/lib/Maypole/View/TT.pm index 7a2ab03..5778d8b 100644 --- a/lib/Maypole/View/TT.pm +++ b/lib/Maypole/View/TT.pm @@ -12,7 +12,6 @@ our $VERSION = 2.11; sub template { my ( $self, $r ) = @_; - unless ($self->{tt}) { my $view_options = $r->config->view_options || {}; $self->{provider} = Template::Provider->new($view_options); @@ -25,16 +24,24 @@ sub template { $self->{provider}->include_path([ $self->paths($r) ]); my $template_file = $r->template; + my $ext = $r->config->template_extension; $template_file .= $ext if defined $ext; my $output; - if ($self->{tt}->process($template_file, { $self->vars($r) }, \$output )) { - $r->{output} = $output; - return OK; + my $processed_ok = eval{$self->{tt}->process($template_file, { $self->vars($r) }, \$output );}; + if ($processed_ok) { + $r->{output} = $output; + return OK; } else { + if ($@) { + warn "fatal error in template '$template_file' : $@\n"; + $r->{error} = "fatal error in template '$template_file' : $@"; + } else { + warn "TT error for template '$template_file'\n" . $self->{tt}->error; $r->{error} = "TT error for template '$template_file'\n" . $self->{tt}->error; - return ERROR; + } + return ERROR; } } diff --git a/t/01basics.t b/t/01basics.t index 5de19c8..7da48b2 100644 --- a/t/01basics.t +++ b/t/01basics.t @@ -2,7 +2,7 @@ use Test::More; use lib 'ex'; # Where BeerDB should live BEGIN { - #$ENV{BEERDB_DEBUG} = 2; + $ENV{BEERDB_DEBUG} = 2; eval { require BeerDB }; Test::More->import( skip_all =>