lib/Maypole/Model/CDBI/Plain.pm

   1 package Maypole::Model::CDBI::Plain;
   2 use Class::C3;
   3 use Maypole::Config;
   4 use base 'Maypole::Model::CDBI';
   5 use strict;
   6
   7 Maypole::Config->mk_accessors(qw(table_to_class));
   8
   9 =head1 NAME
  10
  11 Maypole::Model::CDBI::Plain - Class::DBI model without ::Loader
  12
  13 =head1 SYNOPSIS
  14
  15     package Foo;
  16     use 'Maypole::Application';
  17
  18     Foo->config->model("Maypole::Model::CDBI::Plain");
  19     Foo->setup([qw/ Foo::SomeTable Foo::Other::Table /]);
  20
  21     # untaint columns and provide custom actions for each class
  22
  23     Foo::SomeTable->untaint_columns(email => ['email'], printable => [qw/name description/]);
  24
  25     Foo::Other::Table->untaint_columns ( ... );
  26
  27     sub Foo::SomeTable::SomeAction : Exported {
  28
  29         . . .
  30
  31     }
  32
  33 =head1 DESCRIPTION
  34
  35 This module allows you to use Maypole with previously set-up
  36 L<Class::DBI> classes; simply call C<setup> with a list reference
  37 of the classes you're going to use, and Maypole will work out the
  38 tables and set up the inheritance relationships as normal.
  39
  40 =head1 METHODS
  41
  42 =head2 setup
  43
  44   This method is inherited from Maypole::Model::Base and calls setup_database,
  45   which uses Class::DBI::Loader to create and load Class::DBI classes from
  46   the given database schema.
  47
  48 =head2 setup_database
  49
  50   This method loads the model classes for the application
  51
  52 =cut
  53
  54
  55
  56 sub setup_database {
  57     my ( $self, $config, $namespace, $classes ) = @_;
  58     $config->{classes}        = $classes;
  59     foreach my $class (@$classes) { $namespace->load_model_subclass($class); }
  60     $namespace->model_classes_loaded(1);
  61     $config->{table_to_class} = { map { $_->table => $_ } @$classes };
  62     $config->{tables}         = [ keys %{ $config->{table_to_class} } ];
  63 }
  64
  65 =head2 class_of
  66
  67   returns class for given table
  68
  69 =cut
  70
  71 sub class_of {
  72     my ( $self, $r, $table ) = @_;
  73     return $r->config->{table_to_class}->{$table};
  74 }
  75
  76 =head2 adopt
  77
  78 This class method is passed the name of a model class that represensts a table
  79 and allows the master model class to do any set-up required.
  80
  81 =cut
  82
  83 sub adopt {
  84     my ( $self, $child ) = @_;
  85     if ( my $col = $child->stringify_column ) {
  86         $child->columns( Stringify => $col );
  87     }
  88 }
  89
  90 =head1 SEE ALSO
  91
  92 L<Maypole::Model::Base>
  93
  94 L<Maypole::Model::CDBI>
  95
  96 =cut
  97
  98
  99 1;
 100
 101