X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI.pm;h=c80a2902e0ad69cd74bb507a4abd56d43dfbb25a;hb=3323461600041b1b4f420cb8487637067bc2a5fc;hp=6ad14171255cad627ee61722099fbe4cd190a71a;hpb=5f530b5f17106319faa2f437a567332c86bf6a2c;p=maypole.git diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 6ad1417..c80a290 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -1,6 +1,10 @@ package Maypole::Model::CDBI; use base qw(Maypole::Model::Base Class::DBI); use Class::DBI::AsForm; +# use Maypole::Form::CDBI; +use CGI::Untaint; +# use Maypole::Form; + use Class::DBI::FromCGI; use Class::DBI::Loader; use Class::DBI::AbstractSearch; @@ -8,7 +12,7 @@ use Class::DBI::Plugin::RetrieveAll; use Class::DBI::Pager; use Lingua::EN::Inflect::Number qw(to_PL); -use CGI::Untaint; + use strict; =head1 NAME @@ -17,11 +21,62 @@ Maypole::Model::CDBI - Model class based on Class::DBI =head1 DESCRIPTION -This is a master model class which uses C to do all the hard +This is a master model class which uses L to do all the hard work of fetching rows and representing them as objects. It is a good model to copy if you're replacing it with other database abstraction modules. +It implements a base set of methods required for a Maypole Data Model. +See L for these: + +=over 4 + +=item adopt + +=item class_of + +=item do_edit + +=item list + +=item related + +=item setup_database + +=item fetch_objects + +=back + +=head1 Additional Actions + +=over + +=item delete + +Unsuprisingly, this command causes a database record to be forever lost. + +=item search + +The search action + +=back + +=head1 Helper Methods + +=over + +=item order + +=item stringify_column + +=item do_pager + +=item related_class + +Given an accessor name as a method, this function returns the class this accessor returns. + +=back + =cut sub related { @@ -29,37 +84,63 @@ sub related { return keys %{ $self->meta_info('has_many') || {} }; } +sub related_class { + my ( $self, $r, $accessor ) = @_; + + my $related = $self->meta_info( has_many => $accessor ) || + $self->meta_info( has_a => $accessor ) || + return; + + my $mapping = $related->{args}->{mapping} || []; + if ( @$mapping ) { + return $related->{foreign_class}->meta_info('has_a')->{ $$mapping[0] } + ->{foreign_class}; + } + else { + return $related->{foreign_class}; + } +} + sub do_edit : Exported { my ( $self, $r ) = @_; my $h = CGI::Untaint->new( %{ $r->{params} } ); my $creating = 0; my ($obj) = @{ $r->objects || [] }; + my $fatal; if ($obj) { - # We have something to edit - $obj->update_from_cgi( $h => - { required => $r->{config}{ $r->{table} }{required_cols} || [], } - ); + eval { + $obj->update_from_cgi( $h => + { required => $r->{config}{ $r->{table} }{required_cols} || [], } + ); + }; + $fatal = $@; } else { - $obj = - $self->create_from_cgi( $h => - { required => $r->{config}{ $r->{table} }{required_cols} || [], } - ); + eval { + $obj = + $self->create_from_cgi( $h => + { required => $r->{config}{ $r->{table} }{required_cols} || [], } + ); + }; + if ($fatal = $@) { + warn "$fatal" if $r->debug; + } $creating++; } - if ( my %errors = $obj->cgi_update_errors ) { + if ( my %errors = $fatal ? (FATAL => $fatal) : $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 + + undef $obj if $creating; + $r->template("edit"); } else { $r->{template} = "view"; } - $r->objects( [$obj] ); + $r->objects( $obj ? [$obj] : []); } sub delete : Exported { @@ -75,6 +156,7 @@ sub stringify_column { my $class = shift; return ( $class->columns("Stringify"), + ( grep { /^(name|title)$/i } $class->columns ), ( grep { /(name|title)/i } $class->columns ), ( grep { !/id$/i } $class->primary_columns ), )[0]; @@ -97,7 +179,8 @@ sub search : Exported { my $oper = "like"; # For now my %params = %{ $r->{params} }; my %values = map { $_ => { $oper, $params{$_} } } - grep { $params{$_} and $fields{$_} } keys %params; + grep { defined $params{$_} && length ($params{$_}) && $fields{$_} } + keys %params; $r->template("list"); if ( !%values ) { return $self->list($r) } @@ -105,8 +188,9 @@ sub search : Exported { $self = $self->do_pager($r); $r->objects( [ - $self->search_where( \%values ), - ( $order ? { order => $order } : () ) + $self->search_where( + \%values, ( $order ? { order_by => $order } : () ) + ) ] ); $r->{template_args}{search} = 1; @@ -123,13 +207,13 @@ sub do_pager { sub order { 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" ); - } - $order; - } + my $q = $r->query; + my $order = $q->{order}; + return unless $order and $ok_columns{$order}; + $order .= ' DESC' if $q->{o2} and $q->{o2} eq 'desc'; + return $order; +} sub list : Exported { my ( $self, $r ) = @_; @@ -144,21 +228,26 @@ sub list : Exported { } sub setup_database { - my ($self, $config, $namespace, $dsn, $u, $p, $opts) = @_; + my ( $class, $config, $namespace, $dsn, $u, $p, $opts ) = @_; $dsn ||= $config->dsn; $u ||= $config->user; $p ||= $config->pass; $opts ||= $config->opts; $config->dsn($dsn); - $config->loader || $config->loader( Class::DBI::Loader->new( - namespace => $namespace, - dsn => $dsn, - user => $u, - password => $p, - options => $opts, - ) ); + warn "No DSN set in config" unless $dsn; + $config->loader || $config->loader( + Class::DBI::Loader->new( + namespace => $namespace, + dsn => $dsn, + user => $u, + password => $p, + %$opts, + ) + ); $config->{classes} = [ $config->{loader}->classes ]; $config->{tables} = [ $config->{loader}->tables ]; + warn( 'Loaded tables: ' . join ',', @{ $config->{tables} } ) + if $namespace->debug; } sub class_of { @@ -166,5 +255,15 @@ sub class_of { return $r->config->loader->_table2class($table); } -1; +sub fetch_objects { + my ($class, $r)=@_; + my @pcs = $class->primary_columns; + if ( $#pcs ) { + my %pks; + @pks{@pcs}=(@{$r->{args}}); + return $class->retrieve( %pks ); + } + return $class->retrieve( $r->{args}->[0] ); +} +1;