X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI.pm;h=14f2f0b8ca3e6e60751c722ddef578f80996b79f;hb=22d37ee308fb33851a41cfa724d34ab9528cc57f;hp=171c9164b21de239d2dcde9e75f20200eebb2765;hpb=2225b4184a391bab5f1d9498d5b695ba0c2f09f2;p=maypole.git diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 171c916..14f2f0b 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -22,6 +22,55 @@ 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 + +=back + +=head1 Additional Commands + +=over + +=item delete + +Surprisingly, 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,6 +78,18 @@ sub related { return keys %{ $self->meta_info('has_many') || {} }; } +sub related_class { + my ( $self, $r, $accessor ) = @_; + my $related = $self->related->{$accessor}; + if ( my $mapping = $related->{args}->{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} } ); @@ -97,7 +158,7 @@ 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{$_} and $fields{$_} } keys %params; $r->template("list"); if ( !%values ) { return $self->list($r) } @@ -106,7 +167,7 @@ sub search : Exported { $r->objects( [ $self->search_where( - \%values, ( $order ? { order => $order } : () ) + \%values, ( $order ? { order_by => $order } : () ) ) ] ); @@ -151,6 +212,7 @@ sub setup_database { $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, @@ -162,6 +224,8 @@ sub setup_database { ); $config->{classes} = [ $config->{loader}->classes ]; $config->{tables} = [ $config->{loader}->tables ]; + warn( 'Loaded tables: ' . join ',', @{ $config->{tables} } ) + if $namespace->debug; } sub class_of { @@ -170,4 +234,3 @@ sub class_of { } 1; -