From 5ba93a09518403ae28e8a71b5299e2458a6dfa0b Mon Sep 17 00:00:00 2001 From: Sebastian Riedel Date: Sat, 18 Sep 2004 19:09:02 +0000 Subject: [PATCH] view exceptions and some code cleaning git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@196 48953598-375a-da11-a14b-00016c27c3ee --- lib/CGI/Maypole.pm | 2 +- lib/Maypole.pm | 12 ++- lib/Maypole/CLI.pm | 33 ++++---- lib/Maypole/Constants.pm | 4 +- lib/Maypole/Model/Base.pm | 39 +++++---- lib/Maypole/Model/CDBI.pm | 135 +++++++++++++++++--------------- lib/Maypole/Model/CDBI/Plain.pm | 12 +-- lib/Maypole/View/Base.pm | 67 ++++++++-------- lib/Maypole/View/TT.pm | 10 ++- 9 files changed, 180 insertions(+), 134 deletions(-) diff --git a/lib/CGI/Maypole.pm b/lib/CGI/Maypole.pm index b937d82..bc31321 100644 --- a/lib/CGI/Maypole.pm +++ b/lib/CGI/Maypole.pm @@ -40,7 +40,7 @@ sub send_output { my $r = shift; print $r->{cgi}->header( -type => $r->{content_type}, - -charset => $r->{document_encoding}, + -charset => $r->{document_encoding}, -content_length => length $r->{output}, ); print $r->{output}; diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 53e9be5..4a52011 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -83,7 +83,7 @@ sub handler_guts { if ( my $error = $@ ) { $status = $r->call_exception($error); if ( $status != OK ) { - warn "caught model error: $error"; + warn "caught authenticate error: $error"; return $r->debug ? $r->view_object->error( $r, $error ) : ERROR; } } @@ -106,7 +106,15 @@ sub handler_guts { } } if ( !$r->{output} ) { # You might want to do it yourself - return $r->view_object->process($r); + eval { $status = $r->view_object->process($r) }; + if ( my $error = $@ ) { + $status = $r->call_exception($error); + if ( $status != OK ) { + warn "caught view error: $error"; + return $r->debug ? $r->view_object->error( $r, $error ) : ERROR; + } + } + return $status; } else { return OK; } } diff --git a/lib/Maypole/CLI.pm b/lib/Maypole/CLI.pm index b08aab1..fec6f5e 100644 --- a/lib/Maypole/CLI.pm +++ b/lib/Maypole/CLI.pm @@ -1,27 +1,29 @@ package Maypole::CLI; use UNIVERSAL::require; -use URI; use URI::QueryParam; +use URI; +use URI::QueryParam; use Maypole::Constants; use strict; use warnings; my $package; our $buffer; -sub import { + +sub import { $package = $_[1]; $package->require; die "Couldn't require $package - $@" if $@; no strict 'refs'; - unshift @{$package."::ISA"}, "Maypole::CLI"; + unshift @{ $package . "::ISA" }, "Maypole::CLI"; } -sub get_request {} +sub get_request { } sub get_template_root { $ENV{MAYPOLE_TEMPLATES} || "." } sub parse_location { my $self = shift; - my $url = URI->new(shift @ARGV); - my $root = URI->new($self->config->{uri_base})->path; + my $url = URI->new( shift @ARGV ); + my $root = URI->new( $self->config->{uri_base} )->path; $self->{path} = $url->path; $self->{path} =~ s/^$root//i if $root; $self->parse_path; @@ -29,22 +31,25 @@ sub parse_location { } sub parse_args { - my ($self,$url) = @_; + my ( $self, $url ) = @_; $self->{params} = $url->query_form_hash; - $self->{query} = $url->query_form_hash; + $self->{query} = $url->query_form_hash; } sub send_output { $buffer = shift->{output} } sub call_url { - my $self =shift; - @ARGV=@_; - $package->handler() == OK and return $buffer; + my $self = shift; + @ARGV = @_; + $package->handler() == OK and return $buffer; } + # Do it! -CHECK { if ((caller(0))[1] eq "-e") { - $package->handler() == OK and print $buffer; - } } +CHECK { + if ( ( caller(0) )[1] eq "-e" ) { + $package->handler() == OK and print $buffer; + } +} 1; diff --git a/lib/Maypole/Constants.pm b/lib/Maypole/Constants.pm index 7bddbac..a758584 100644 --- a/lib/Maypole/Constants.pm +++ b/lib/Maypole/Constants.pm @@ -1,7 +1,7 @@ package Maypole::Constants; use base 'Exporter'; -use constant OK => 0; +use constant OK => 0; use constant DECLINED => -1; -use constant ERROR => -1; +use constant ERROR => -1; our @EXPORT = qw(OK DECLINED ERROR); 1; diff --git a/lib/Maypole/Model/Base.pm b/lib/Maypole/Model/Base.pm index 6e60aea..804f235 100644 --- a/lib/Maypole/Model/Base.pm +++ b/lib/Maypole/Model/Base.pm @@ -1,27 +1,31 @@ package Maypole::Model::Base; our %remember; -sub MODIFY_CODE_ATTRIBUTES { $remember{$_[1]} = $_[2]; () } +sub MODIFY_CODE_ATTRIBUTES { $remember{ $_[1] } = $_[2]; () } -sub FETCH_CODE_ATTRIBUTES { $remember{$_[1]} } -sub view :Exported { } -sub edit :Exported { } +sub FETCH_CODE_ATTRIBUTES { $remember{ $_[1] } } + +sub view : Exported { +} + +sub edit : Exported { +} sub process { - my ($class, $r) = @_; + my ( $class, $r ) = @_; my $method = $r->action; - return if $r->{template}; # Authentication has set this, we're done. + return if $r->{template}; # Authentication has set this, we're done. $r->{template} = $method; - $r->objects([]); + $r->objects( [] ); my $obj = $class->retrieve( $r->{args}->[0] ); if ($obj) { - $r->objects([ $obj ]); - shift @{$r->{args}}; + $r->objects( [$obj] ); + shift @{ $r->{args} }; } - $class->$method($r, $obj, @{$r->{args}}); + $class->$method( $r, $obj, @{ $r->{args} } ); } -sub display_columns { +sub display_columns { sort shift->columns; } @@ -106,7 +110,10 @@ similar. sub class_of { die "This is an abstract method" } sub setup_database { die "This is an abstract method" } -sub list :Exported { die "This is an abstract method" }; + +sub list : Exported { + die "This is an abstract method"; +} =pod @@ -123,10 +130,14 @@ Return a hash mapping column names with human-readable equivalents. =cut -sub column_names { my $class = shift; map { +sub column_names { + my $class = shift; + map { my $col = $_; $col =~ s/_+(\w)?/ \U$1/g; - $_ => ucfirst $col } $class->columns } + $_ => ucfirst $col + } $class->columns; +} =head2 description diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 2a79850..e1d6652 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -25,131 +25,144 @@ modules. =cut sub related { - my ($self, $r) = @_; - return keys %{$self->meta_info('has_many') || {}}; + my ( $self, $r ) = @_; + return keys %{ $self->meta_info('has_many') || {} }; } -sub do_edit :Exported { - my ($self, $r) = @_; - my $h = CGI::Untaint->new(%{$r->{params}}); +sub do_edit : Exported { + my ( $self, $r ) = @_; + my $h = CGI::Untaint->new( %{ $r->{params} } ); my $creating = 0; - my ($obj) = @{$r->objects || []}; + my ($obj) = @{ $r->objects || [] }; if ($obj) { + # We have something to edit - $obj->update_from_cgi($h => { - required => $r->{config}{$r->{table}}{required_cols} || [], - }); - } else { - $obj = $self->create_from_cgi($h => { - required => $r->{config}{$r->{table}}{required_cols} || [], - }); + $obj->update_from_cgi( $h => + { required => $r->{config}{ $r->{table} }{required_cols} || [], } + ); + } + else { + $obj = + $self->create_from_cgi( $h => + { required => $r->{config}{ $r->{table} }{required_cols} || [], } + ); $creating++; } - if (my %errors = $obj->cgi_update_errors) { + if ( my %errors = $obj->cgi_update_errors ) { + # Set it up as it was: $r->{template_args}{cgi_params} = $r->{params}; - $r->{template_args}{errors} = \%errors; - $r->{template} = "edit"; - undef $obj if $creating; # Couldn't create - } else { + $r->{template_args}{errors} = \%errors; + $r->{template} = "edit"; + undef $obj if $creating; # Couldn't create + } + else { $r->{template} = "view"; } - $r->objects([ $obj ]); + $r->objects( [$obj] ); } -sub delete :Exported { +sub delete : Exported { return shift->SUPER::delete(@_) if caller ne "Maypole::Model::Base"; - my ($self, $r) = @_; + my ( $self, $r ) = @_; $_->SUPER::delete for @{ $r->objects || [] }; - $r->objects([ $self->retrieve_all ]); + $r->objects( [ $self->retrieve_all ] ); $r->{template} = "list"; $self->list($r); } sub stringify_column { my $class = shift; - return ($class->columns("Stringify"), - (grep { /(name|title)/i } $class->columns), - (grep { !/id$/i } $class->primary_columns), - )[0]; + return ( + $class->columns("Stringify"), + ( grep { /(name|title)/i } $class->columns ), + ( grep { !/id$/i } $class->primary_columns ), + )[0]; } sub adopt { - my ($self, $child) = @_; + my ( $self, $child ) = @_; $child->autoupdate(1); - if (my $col = $child->stringify_column) { + if ( my $col = $child->stringify_column ) { $child->columns( Stringify => $col ); } } -sub search :Exported { +sub search : Exported { return shift->SUPER::search(@_) if caller ne "Maypole::Model::Base"; - # A real CDBI search. - my ($self, $r) = @_; - my %fields = map {$_ => 1 } $self->columns; - my $oper = "like"; # For now - my %params = %{$r->{params}}; - my %values = map { $_ => {$oper, $params{$_} } } - grep { $params{$_} and $fields{$_} } keys %params; + + # A real CDBI search. + my ( $self, $r ) = @_; + my %fields = map { $_ => 1 } $self->columns; + my $oper = "like"; # For now + my %params = %{ $r->{params} }; + my %values = map { $_ => { $oper, $params{$_} } } + grep { $params{$_} and $fields{$_} } keys %params; $r->template("list"); - if (!%values) { return $self->list($r) } + if ( !%values ) { return $self->list($r) } my $order = $self->order($r); $self = $self->do_pager($r); - $r->objects([ $self->search_where(\%values), - ($order ? { order => $order } : ()) - ]); + $r->objects( + [ + $self->search_where( \%values ), + ( $order ? { order => $order } : () ) + ] + ); $r->{template_args}{search} = 1; } sub do_pager { - my ($self, $r) = @_; - if ( my $rows = $r->config->{rows_per_page}) { - return $r->{template_args}{pager} = $self->pager($rows, $r->query->{page}); - } else { return $self } + my ( $self, $r ) = @_; + if ( my $rows = $r->config->{rows_per_page} ) { + return $r->{template_args}{pager} = + $self->pager( $rows, $r->query->{page} ); + } + else { return $self } } sub order { - my ($self, $r) = @_; + my ( $self, $r ) = @_; my $order; - my %ok_columns = map {$_ => 1} $self->columns; - if ($order = $r->query->{order} and $ok_columns{$order}) { - $order .= ($r->query->{o2} eq "desc" && " DESC") + my %ok_columns = map { $_ => 1 } $self->columns; + if ( $order = $r->query->{order} and $ok_columns{$order} ) { + $order .= ( $r->query->{o2} eq "desc" && " DESC" ); } $order; } -sub list :Exported { - my ($self, $r) = @_; +sub list : Exported { + my ( $self, $r ) = @_; my $order = $self->order($r); $self = $self->do_pager($r); - if ($order) { - $r->objects([ $self->retrieve_all_sorted_by( $order )]); - } else { - $r->objects([ $self->retrieve_all ]); + if ($order) { + $r->objects( [ $self->retrieve_all_sorted_by($order) ] ); + } + else { + $r->objects( [ $self->retrieve_all ] ); } } sub setup_database { - my ($self, $config, $namespace, $dsn, $u, $p, $opts) = @_; + my ( $self, $config, $namespace, $dsn, $u, $p, $opts ) = @_; $dsn ||= $config->{dsn}; $u ||= $config->{user}; $p ||= $config->{pass}; $opts ||= $config->{opts}; - $config->{dsn} = $dsn; + $config->{dsn} = $dsn; $config->{loader} = Class::DBI::Loader->new( namespace => $namespace, - dsn => $dsn, - user => $u, - password => $p, - options => $opts, + dsn => $dsn, + user => $u, + password => $p, + options => $opts, ); $config->{classes} = [ $config->{loader}->classes ]; $config->{tables} = [ $config->{loader}->tables ]; } sub class_of { - my ($self, $r, $table) = @_; + my ( $self, $r, $table ) = @_; return $r->config->{loader}->_table2class($table); } diff --git a/lib/Maypole/Model/CDBI/Plain.pm b/lib/Maypole/Model/CDBI/Plain.pm index 05aad18..114eb88 100644 --- a/lib/Maypole/Model/CDBI/Plain.pm +++ b/lib/Maypole/Model/CDBI/Plain.pm @@ -1,14 +1,15 @@ package Maypole::Model::CDBI::Plain; use base 'Maypole::Model::CDBI'; + sub setup_database { - my ($self, $config, $namespace, $classes) = @_; - $config->{classes} = $classes; - $config->{table_to_class} = { map { $_->table => $_ } @$classes }; - $config->{tables} = [ keys %{$config->{table_to_class}} ]; + my ( $self, $config, $namespace, $classes ) = @_; + $config->{classes} = $classes; + $config->{table_to_class} = { map { $_->table => $_ } @$classes }; + $config->{tables} = [ keys %{ $config->{table_to_class} } ]; } sub class_of { - my ($self, $r, $table) = @_; + my ( $self, $r, $table ) = @_; return $r->config->{table_to_class}->{$table}; } @@ -36,3 +37,4 @@ of the classes you're going to use, and Maypole will work out the tables and set up the inheritance relationships as normal. =cut + diff --git a/lib/Maypole/View/Base.pm b/lib/Maypole/View/Base.pm index 51c2cb6..61c887d 100644 --- a/lib/Maypole/View/Base.pm +++ b/lib/Maypole/View/Base.pm @@ -4,73 +4,78 @@ use UNIVERSAL::moniker; use strict; use Maypole::Constants; -sub new { bless {}, shift } # By default, do nothing. +sub new { bless {}, shift } # By default, do nothing. sub paths { - my ($self, $r) = @_; + my ( $self, $r ) = @_; my $root = $r->{config}{template_root} || $r->get_template_root; return ( $root, - ($r->model_class && - File::Spec->catdir($root, $r->model_class->moniker)), - File::Spec->catdir($root, "custom"), - File::Spec->catdir($root, "factory") + ( + $r->model_class + && File::Spec->catdir( $root, $r->model_class->moniker ) + ), + File::Spec->catdir( $root, "custom" ), + File::Spec->catdir( $root, "factory" ) ); } sub vars { - my ($self, $r) = @_; + my ( $self, $r ) = @_; my $class = $r->model_class; - my $base = $r->{config}->{uri_base}; + my $base = $r->{config}->{uri_base}; $base =~ s/\/+$//; my %args = ( request => $r, objects => $r->objects, base => $base, config => $r->config - # ... - ) ; - if ($class) { + + # ... + ); + if ($class) { $args{classmetadata} = { - name => $class, - table => $class->table, - columns => [ $class->display_columns ], - colnames => { $class->column_names }, + name => $class, + table => $class->table, + columns => [ $class->display_columns ], + colnames => { $class->column_names }, related_accessors => [ $class->related($r) ], - moniker => $class->moniker, - plural => $class->plural_moniker, - cgi => { $class->to_cgi }, + moniker => $class->moniker, + plural => $class->plural_moniker, + cgi => { $class->to_cgi }, }; # User-friendliness facility for custom template writers. - if (@{$r->objects || []} > 1) { - $args{$r->model_class->plural_moniker} = $r->objects; - } else { - ($args{$r->model_class->moniker}) = @{$r->objects ||[]}; + if ( @{ $r->objects || [] } > 1 ) { + $args{ $r->model_class->plural_moniker } = $r->objects; + } + else { + ( $args{ $r->model_class->moniker } ) = @{ $r->objects || [] }; } } # Overrides - %args = (%args, %{$r->{template_args}||{}}); + %args = ( %args, %{ $r->{template_args} || {} } ); %args; } sub process { - my ($self, $r) = @_; + my ( $self, $r ) = @_; my $status = $self->template($r); return $self->error($r) if $status != OK; - $r->{content_type} ||= "text/html"; + $r->{content_type} ||= "text/html"; $r->{document_encoding} ||= "utf-8"; return OK; } sub error { - my ($self, $r) = @_; + my ( $self, $r ) = @_; warn $r->{error}; - if ($r->{error} =~ /not found$/) { + if ( $r->{error} =~ /not found$/ ) { + # This is a rough test to see whether or not we're a template or # a static page - return -1 unless @{$r->{objects}||[]}; + return -1 unless @{ $r->{objects} || [] }; $r->{error} = <@{[$r->{template}]} in paths: EOF $r->{content_type} = "text/html"; - $r->{output} = $r->{error}; + $r->{output} = $r->{error}; return OK; } $r->{content_type} = "text/plain"; - $r->{output} = $r->{error}; + $r->{output} = $r->{error}; $r->send_output; return ERROR; } -sub template { die shift()." didn't define a decent template method!" } +sub template { die shift() . " didn't define a decent template method!" } 1; diff --git a/lib/Maypole/View/TT.pm b/lib/Maypole/View/TT.pm index 0e8d89f..9142f3e 100644 --- a/lib/Maypole/View/TT.pm +++ b/lib/Maypole/View/TT.pm @@ -4,13 +4,14 @@ use Maypole::Constants; use Template; sub template { - my ($self, $r) = @_; - my $template = Template->new({ INCLUDE_PATH => [ $self->paths($r) ]}); + my ( $self, $r ) = @_; + my $template = Template->new( { INCLUDE_PATH => [ $self->paths($r) ] } ); my $output; - if ($template->process($r->template, { $self->vars($r) }, \$output)) { + if ( $template->process( $r->template, { $self->vars($r) }, \$output ) ) { $r->{output} = $output; return OK; - } else { + } + else { $r->{error} = $template->error; return ERROR; } @@ -39,3 +40,4 @@ components are resolved. Simon Cozens =cut + -- 2.39.2