X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI.pm;h=b3223c4d7887c0235324e4971e01045cdd658b65;hb=e767951f92d57740dc76425868cce32f6bcf1296;hp=34aa7417d10a0880f863d6241979a28db7b04d91;hpb=6d2982560f68030ec5153d40e444575745640688;p=maypole.git diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 34aa741..b3223c4 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -1,13 +1,4 @@ package Maypole::Model::CDBI; -use base qw(Maypole::Model::Base Class::DBI); -use Lingua::EN::Inflect::Number qw(to_PL); -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 CGI::Untaint; use strict; =head1 NAME @@ -16,110 +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); - warn "Updating an object ($obj) with ".Dumper($h); use Data::Dumper; - } else { - $obj = $self->create_from_cgi($h); - } - if (my %errors = $obj->cgi_update_errors) { - # Set it up as it was: - warn "There were errors: ".Dumper(\%errors)."\n"; - $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 { - my ($self, $r) = @_; - $_->SUPER::delete for @{ $r->objects || [] }; - $r->objects([ $self->retrieve_all ]); - $r->{template} = "list"; -} +=head2 Untainter -sub adopt { - my ($self, $child) = @_; - $child->autoupdate(1); - if (grep { $_ eq "name" } $child->columns) { # Common case - $child->columns( Stringify => qw/ name / ); - } # Otherwise, work it out for yourself. -} +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 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 - use Carp; Carp::confess("Urgh") unless ref $r; - my %params = %{$r->{params}}; - my %values = map { $_ => {$oper, $params{$_} } } - grep { $params{$_} and $fields{$_} } keys %params; - - $r->objects([ %values ? $self->search_where(%values) : $self->retrieve_all ]); - $r->template("list"); - $r->{template_args}{search} = 1; -} +=cut -sub list :Exported { - my ($self, $r) = @_; - my %ok_columns = map {$_ => 1} $self->columns; - if ( my $rows = $r->config->{rows_per_page}) { - $self = $self->pager($rows, $r->query->{page}); - $r->{template_args}{pager} = $self; - } - my $order; - if ($order = $r->query->{order} and $ok_columns{$order}) { - $r->objects([ $self->retrieve_all_sorted_by( $order. - ($r->query->{o2} eq "desc" && " DESC") - )]); - } else { - $r->objects([ $self->retrieve_all ]); - } -} +sub Untainter { 'CGI::Untaint::Maypole' }; + +=head2 add_model_superclass + +Adds model as superclass to model classes (if necessary) + +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;