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)
Test::MockModule => 0,
Digest::MD5 => 0,
File::MMagic::XS => 0.08,
+ Class::DBI::Plugin::Type => 0,
}, # e.g., Module::Name => 1.1
(
$] >= 5.005
use UNIVERSAL::require;
use strict;
use warnings;
+use Data::Dumper;
use Maypole::Config;
use Maypole::Constants;
use Maypole::Headers;
=cut
-sub debug { 0 }
+sub debug { 1 }
=item config
# 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
$self->get_user;
my $status = $self->handler_guts;
+
return $status unless $status == OK;
# TODO: require send_output to return a status code
$self->__load_request_model;
my $applicable = $self->is_model_applicable == OK;
-
+
+ warn "applicable : $applicable";
+
$self->__setup_plain_template unless $applicable;
my $status;
$self->view_object->error( $self,
"Got unexpected status $status from calling authentication" );
}
-
+
return $status unless $status == OK;
# We run additional_data for every request
# 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;
}
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;
}
# 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
=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
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;
# 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;
$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);
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;
}
=cut
-\r
-\r
-\r
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} = <<EOF;
-
<h1> Template not found </h1>
A template was not found while processing the following request:
$r->{output} = $r->{error};
return OK;
}
- $r->{content_type} = "text/plain";
- $r->{output} = $r->{error};
- $r->send_output;
return ERROR;
}
sub template {
my ( $self, $r ) = @_;
-
unless ($self->{tt}) {
my $view_options = $r->config->view_options || {};
$self->{provider} = Template::Provider->new($view_options);
$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;
}
}
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 =>
projects / maypole.git / commitdiff