lib/Maypole/Model/CDBI/DFV.pm

   1 package Maypole::Model::CDBI::DFV;
   2 use Class::C3;
   3 use Maypole::Config;
   4 use base qw(Maypole::Model::Base);
   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::DFV");
  19     Foo->setup([qw/ Foo::SomeTable Foo::Other::Table /]);
  20
  21     # Look ma, no untainting
  22
  23     sub Foo::SomeTable::SomeAction : Exported {
  24
  25         . . .
  26
  27     }
  28
  29 =head1 DESCRIPTION
  30
  31 This module allows you to use Maypole with previously set-up
  32 L<Class::DBI> classes that use Class::DBI::DFV;
  33
  34 Simply call C<setup> with a list reference of the classes you're going to use,
  35 and Maypole will work out the tables and set up the inheritance relationships
  36 as normal.
  37
  38 Better still, it will also set use your DFV profile to validate input instead
  39 of CGI::Untaint. For teh win!!
  40
  41 =head1 METHODS
  42
  43 =head2 setup
  44
  45   This method is inherited from Maypole::Model::Base and calls setup_database,
  46   which uses Class::DBI::Loader to create and load Class::DBI classes from
  47   the given database schema.
  48
  49 =head2 setup_database
  50
  51   This method loads the model classes for the application
  52
  53 =cut
  54
  55 sub setup_database {
  56     my ( $self, $config, $namespace, $classes ) = @_;
  57     $config->{classes}        = $classes;
  58     foreach my $class (@$classes) { $namespace->load_model_subclass($class); }
  59     $namespace->model_classes_loaded(1);
  60     $config->{table_to_class} = { map { $_->table => $_ } @$classes };
  61     $config->{tables}         = [ keys %{ $config->{table_to_class} } ];
  62 }
  63
  64 =head2 class_of
  65
  66   returns class for given table
  67
  68 =cut
  69
  70 sub class_of {
  71     my ( $self, $r, $table ) = @_;
  72     return $r->config->{table_to_class}->{$table};
  73 }
  74
  75 =head2 add_model_superclass
  76
  77 Adds model as superclass to model classes
  78
  79 =cut
  80
  81 sub add_model_superclass {
  82   my ($class,$config) = @_;
  83   foreach my $subclass ( @{ $config->classes } ) {
  84     next if $subclass->isa("Maypole::Model::Base");
  85     no strict 'refs';
  86     push @{ $subclass . "::ISA" }, $config->model;
  87   }
  88   return;
  89 }
  90
  91 =head2 adopt
  92
  93 This class method is passed the name of a model class that represensts a table
  94 and allows the master model class to do any set-up required.
  95
  96 =cut
  97
  98 sub adopt {
  99     my ( $self, $child ) = @_;
 100     if ( my $col = $child->stringify_column ) {
 101         $child->columns( Stringify => $col );
 102     }
 103 }
 104
 105 =head1 SEE ALSO
 106
 107 L<Maypole::Model::Base>
 108
 109 L<Maypole::Model::CDBI>
 110
 111 =cut
 112
 113
 114 1;
 115
 116