X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI.pm;h=b3223c4d7887c0235324e4971e01045cdd658b65;hb=e767951f92d57740dc76425868cce32f6bcf1296;hp=495439e4e5df5ed5dd64db0a54150cdca6ea9631;hpb=2c68753ecffdb68833e8dd65bde7d2248e33d317;p=maypole.git diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 495439e..b3223c4 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -1,14 +1,4 @@ package Maypole::Model::CDBI; -use base qw(Maypole::Model::Base Class::DBI); -use Class::DBI::AsForm; -use Class::DBI::FromCGI; -use Class::DBI::Loader; -use Class::DBI::AbstractSearch; -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,133 +7,161 @@ 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. + +It inherits accessor and helper methods from L. + +When specified as the application model, it will use Class::DBI::Loader +to generate the model classes from the provided database. If you do not +wish to use this functionality, use L which +will instead use Class::DBI classes provided. + =cut -sub related { - my ($self, $r) = @_; - # Has-many methods; XXX this is a hack - map {to_PL($_)} - grep { exists $r->{config}{ok_tables}{$_} } - map {$_->table} - keys %{shift->__hasa_list || {}} -} +use base qw(Maypole::Model::CDBI::Base); +use Data::Dumper; +use Class::DBI::Loader; +use attributes (); -sub do_edit :Exported { - my ($self, $r) = @_; - my $h = CGI::Untaint->new(%{$r->{params}}); - my ($obj) = @{$r->objects || []}; - if ($obj) { - # We have something to edit - $obj->update_from_cgi($h); - } else { - $obj = $self->create_from_cgi($h); - } - 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"; - } else { - $r->{template} = "view"; - } - $r->objects([ $obj ]); -} +use Maypole::Model::CDBI::AsForm; +use Maypole::Model::CDBI::FromCGI; +use CGI::Untaint::Maypole; -sub delete :Exported { - return shift->SUPER::delete(@_) if caller ne "Maypole::Model::Base"; - my ($self, $r) = @_; - $_->SUPER::delete for @{ $r->objects || [] }; - $r->objects([ $self->retrieve_all ]); - $r->{template} = "list"; - $self->list($r); -} +=head2 Untainter -sub stringify_column { - my $class = shift; - return ($class->columns("Stringify"), - (grep { $_ ne "id" } $class->primary_columns), - (grep { $_ eq "name" } $class->columns) - )[0]; -} +Set the class you use to untaint and validate form data +Note it must be of type CGI::Untaint::Maypole (takes $r arg) or CGI::Untaint -sub adopt { - my ($self, $child) = @_; - $child->autoupdate(1); - if (my $col = $child->stringify_column) { - $child->columns( Stringify => $col ); - } -} +=cut -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; - - $r->template("list"); - 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->{template_args}{search} = 1; -} +sub Untainter { 'CGI::Untaint::Maypole' }; -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 } -} +=head2 add_model_superclass -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; -} +Adds model as superclass to model classes (if necessary) -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 ]); - } -} +Inherited from Maypole::Model::CDBI::Base + +=head1 Action Methods + +Action methods are methods that are accessed through web (or other public) interface. + +Inherited from L + +=head2 do_edit + +If there is an object in C<$r-Eobjects>, then it should be edited +with the parameters in C<$r-Eparams>; otherwise, a new object should +be created with those parameters, and put back into C<$r-Eobjects>. +The template should be changed to C, or C if there were any +errors. A hash of errors will be passed to the template. + +=head2 do_delete + +Inherited from Maypole::Model::CDBI::Base. + +This action deletes records + +=head2 do_search + +Inherited from Maypole::Model::CDBI::Base. + +This action method searches for database records. + +=head2 list + +Inherited from Maypole::Model::CDBI::Base. + +The C method fills C<$r-Eobjects> with all of the +objects in the class. The results are paged using a pager. + +=head1 Helper Methods + +=head2 setup + + This method is inherited from Maypole::Model::Base and calls setup_database, + which uses Class::DBI::Loader to create and load Class::DBI classes from + the given database schema. + +=cut + +=head2 setup_database + +The $opts argument is a hashref of options. The "options" key is a hashref of +Database connection options . Other keys may be various Loader arguments or +flags. It has this form: + { + # DB connection options + options { AutoCommit => 1 , ... }, + # Loader args + relationships => 1, + ... + } + +=cut sub setup_database { - my ($self, $config, $namespace, $dsn, $u, $p) = @_; - $config->{dsn} = $dsn; - $config->{loader} = Class::DBI::Loader->new( - namespace => $namespace, - dsn => $dsn, - user => $u, - password => $p, + my ( $class, $config, $namespace, $dsn, $u, $p, $opts ) = @_; + $dsn ||= $config->dsn; + $u ||= $config->user; + $p ||= $config->pass; + $opts ||= $config->opts; + $config->dsn($dsn); + 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 ]; + + my @table_class = map { $_ . " => " . $config->{loader}->_table2class($_) } @{ $config->{tables} }; + warn( 'Loaded tables to classes: ' . join ', ', @table_class ) + if $namespace->debug; } +=head2 class_of + + returns class for given table + +=cut + sub class_of { - my ($self, $r, $table) = @_; - return $r->config->{loader}->_table2class($table); + my ( $self, $r, $table ) = @_; + return $r->config->loader->_table2class($table); # why not find_class ? } -1; +=head1 SEE ALSO + +L, L. + +=head1 AUTHOR + +Maypole is currently maintained by Aaron Trevena. + +=head1 AUTHOR EMERITUS + +Simon Cozens, C + +Simon Flack maintained Maypole from 2.05 to 2.09 + +Sebastian Riedel, C maintained Maypole from 1.99_01 to 2.04 + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut + +1;