+=head2 list
+
+The C<list> method fills C<$r-E<gt>objects> with all of the
+objects in the class. The results are paged using a pager.
+
+=cut
+
+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 ] );
+ }
+}
+
+#######################
+# _process_local_srch #
+#######################
+
+# Makes the local part of the db search query
+# Puts search prams local to this table in where array.
+# Returns a where array ref and search criteria string.
+# This is factored out of do_search so sub classes can override this part
+sub _process_local_srch {
+ my ($self, $hashed) = @_;
+ my %fields = map { $_ => 1 } $self->columns;
+ my $moniker = $self->moniker;
+ my %colnames = $self->column_names;
+ my $srch_crit = '';
+ my ($oper, $wc);
+ my @where = map {
+ # prelim
+ $srch_crit .= ' '.$colnames{$_}." = '".$hashed->{$_}."'";
+ $oper = $self->sql_search_oper($_);
+ $wc = $oper =~ /LIKE/i ? '%':''; # match any substr
+ "$moniker.$_ $oper '$wc" . $hashed->{$_} . "$wc'"; #the where clause
+ }
+ grep { defined $hashed->{$_} && length ($hashed->{$_}) && $fields{$_} }
+ keys %$hashed;
+
+ return (\@where, $srch_crit);
+}
+
+#########################
+# _process_foreign_srch #
+#########################
+
+# puts foreign search fields into select statement
+# changes @where by ref and return sel and srch_criteria string
+sub _process_foreign_srch {
+ my ($self, $hashed, $sel, $where, $srch_crit) = @_;
+ my %colnames = $self->column_names;
+ my $moniker = $self->moniker;
+ my %foreign;
+ foreach (keys %$hashed) {
+ $foreign{$_} = delete $hashed->{$_} if ref $hashed->{$_};
+ }
+ my %accssr_class = %{$self->accessor_classes};
+ while (my ( $accssr, $prms) = each %foreign ) {
+ my $fclass = $accssr_class{$accssr};
+ my %fields = map { $_ => 1 } $fclass->columns;
+ my %colnames = $fclass->column_names;
+ my ($oper, $wc);
+ my @this_where =
+ # TODO make field name match in all cases in srch crit
+ map {
+ # prelim
+ $srch_crit.= ' '.$colnames{$_}." = '".$prms->{$_}."'";
+ $oper = $fclass->sql_search_oper($_);
+ $wc = $oper =~ /LIKE/i ? '%':'';
+ "$accssr.$_ $oper '$wc".$prms->{$_}."$wc'"; # the where
+ }
+ grep { defined $prms->{$_} && length ($prms->{$_}) && $fields{$_} }
+ keys %$prms;
+
+ next unless @this_where;
+ $sel .= ", " . $fclass->table . " $accssr"; # add foreign tables to from
+
+ # map relationships -- TODO use constraints in has_many and mhaves
+ # and make general
+ my $pk = $self->primary_column;
+ if ($fclass->find_column('owner_id') && $fclass->find_column('owner_table') ) {
+ unshift @this_where, ("$accssr.owner_id = $moniker.$pk",
+ "$accssr.owner_table = '" . $self->table ."'");
+ }
+ # for has_own, has_a where foreign id is in self's table
+ elsif ( my $fk = $self->find_column($fclass->primary_column) ) {
+ unshift @this_where, "$accssr." . $fk->name . " = $moniker." . $fk->name;
+ }
+ push @$where, @this_where;
+ }
+ return ($sel, $srch_crit);
+}
+
+###############################################################################
+# Helper methods
+
+=head1 Helper Methods
+
+
+=head2 adopt
+
+This class method is passed the name of a model class that represensts a table
+and allows the master model class to do any set-up required.
+
+=cut
+
+sub adopt {
+ my ( $self, $child ) = @_;
+ $child->autoupdate(1);
+ if ( my $col = $child->stringify_column ) {
+ $child->columns( Stringify => $col );
+ }
+}
+
+=head2 is_class
+
+Tell if action is a class method (See Maypole::Plugin::Menu)
+
+=cut
+
+sub is_class {
+ my ( $self, $method, $attrs ) = @_;
+ die "Usage: method must be passed as first arg" unless $method;
+ $attrs = join(' ',$self->method_attrs($method)) unless ($attrs);
+ return 1 if $attrs =~ /\bClass\b/i;
+ return 1 if $method =~ /^list$/; # default class actions
+ return 0;
+}
+
+=head2 is_object
+
+Tell if action is a object method (See Maypole::Plugin::Menu)
+
+=cut
+
+sub is_object {
+ my ( $self, $method, $attrs ) = @_;
+ die "Usage: method must be passed as first arg" unless $method;
+ $attrs = join(' ',$self->method_attrs($method)) unless ($attrs);
+ return 1 if $attrs =~ /\bObject\b/i;
+ return 1 if $method =~ /(^view$|^edit$|^delete$)/; # default object actions
+ return 0;
+}
+
+
+=head2 related
+
+This method returns a list of has-many accessors. A brewery has many
+beers, so C<BeerDB::Brewery> needs to return C<beers>.
+
+=cut
+
+sub related {
+ my ( $self, $r ) = @_;
+ return keys %{ $self->meta_info('has_many') || {} };
+}
+
+
+=head2 related_class
+
+Given an accessor name as a method, this function returns the class this accessor returns.
+
+=cut
+
+sub related_class {
+ my ( $self, $r, $accessor ) = @_;
+ my $meta = $self->meta_info;
+ my @rels = keys %$meta;
+ my $related;
+ foreach (@rels) {
+ $related = $meta->{$_}{$accessor};
+ last if $related;
+ }
+ return unless $related;
+
+ my $mapping = $related->{args}->{mapping};
+ if ( $mapping and @$mapping ) {
+ return $related->{foreign_class}->meta_info('has_a')->{$$mapping[0]}->{foreign_class};
+ }
+ else {
+ return $related->{foreign_class};
+ }
+ }
+
+=head2 related_meta
+
+ $class->related_meta($col);
+
+Given a column associated with a relationship it will return the relatation
+ship type and the meta info for the relationship on the column.
+
+=cut
+
+sub related_meta {
+ my ($self,$r, $accssr) = @_;
+ $self->_croak("You forgot to put the place holder for 'r' or forgot the accssr parameter") unless $accssr;
+ my $class_meta = $self->meta_info;
+ if (my ($rel_type) = grep { defined $class_meta->{$_}->{$accssr} }
+ keys %$class_meta)
+ { return $rel_type, $class_meta->{$rel_type}->{$accssr} };
+}
+
+
+=head2 isa_class
+
+Returns class of a column inherited by is_a.
+
+=cut
+
+# Maybe put this in IsA?
+sub isa_class {
+ my ($class, $col) = @_;
+ $class->_croak( "Need a column for isa_class." ) unless $col;
+ my $isaclass;
+ my $isa = $class->meta_info("is_a") || {};
+ foreach ( keys %$isa ) {
+ $isaclass = $isa->{$_}->foreign_class;
+ return $isaclass if ($isaclass->find_column($col));
+ }
+ return 0; # col not in a is_a class
+}
+
+=head2 accessor_classes
+
+Returns hash ref of classes for accessors.
+
+This is an attempt at a more efficient method than calling "related_class()"
+a bunch of times when you need it for many relations.
+It may be good to call at startup and store in a global config.
+
+=cut
+
+sub accessor_classes {
+ my ($self, $class) = @_; # can pass a class arg to get accssor classes for
+ $class ||= $self;
+ my $meta = $class->meta_info;
+ my %res;
+ foreach my $rel (keys %$meta) {
+ my $rel_meta = $meta->{$rel};
+ %res = ( %res, map { $_ => $rel_meta->{$_}->{foreign_class} }
+ keys %$rel_meta );
+ }
+ return \%res;
+
+ # 2 liner to get class of accessor for $name
+ #my $meta = $class->meta_info;
+ #my ($isa) = map $_->foreign_class, grep defined,
+ # map $meta->{$_}->{$name}, keys %$meta;
+
+}
+
+
+=head2 stringify_column
+
+ Returns the name of the column to use when stringifying
+ and object.
+
+=cut
+
+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];
+}
+
+=head2 do_pager
+
+ Sets the pager template argument ($r->{template_args}{pager})
+ to a Class::DBI::Pager object based on the rows_per_page
+ value set in the configuration of the application.
+
+ This pager is used via the pager macro in TT Templates, and
+ is also accessible via Mason.
+
+=cut
+