lib/Maypole/Model/CDBI/Base.pm

   1 package Maypole::Model::CDBI::Base;
   2 use strict;
   3 use Class::C3;
   4
   5 =head1 NAME
   6
   7 Maypole::Model::CDBI::Base - Model base class based on Class::DBI
   8
   9 =head1 DESCRIPTION
  10
  11 This is a master model class which uses L<Class::DBI> to do all the hard
  12 work of fetching rows and representing them as objects. It is a good
  13 model to copy if you're replacing it with other database abstraction
  14 modules.
  15
  16 It implements a base set of methods required for a Maypole Data Model.
  17
  18 It inherits accessor and helper methods from L<Maypole::Model::Base>.
  19
  20 =cut
  21
  22 use base qw(Maypole::Model::Base Class::DBI);
  23 use Class::DBI::AbstractSearch;
  24 use Class::DBI::Plugin::RetrieveAll;
  25 use Class::DBI::Pager;
  26 use Lingua::EN::Inflect::Number qw(to_PL);
  27 use attributes ();
  28 use Data::Dumper;
  29
  30 __PACKAGE__->mk_classdata($_) for (qw/COLUMN_INFO/);
  31
  32 =head2 add_model_superclass
  33
  34 Adds model as superclass to model classes (if necessary)
  35
  36 =cut
  37
  38 sub add_model_superclass {
  39   my ($class,$config) = @_;
  40   foreach my $subclass ( @{ $config->classes } ) {
  41     next if $subclass->isa("Maypole::Model::Base");
  42     no strict 'refs';
  43     push @{ $subclass . "::ISA" }, $config->model;
  44   }
  45   return;
  46 }
  47
  48 =head1 Action Methods
  49
  50 Action methods are methods that are accessed through web (or other public) interface.
  51
  52 =head2 do_edit
  53
  54 If there is an object in C<$r-E<gt>objects>, then it should be edited
  55 with the parameters in C<$r-E<gt>params>; otherwise, a new object should
  56 be created with those parameters, and put back into C<$r-E<gt>objects>.
  57 The template should be changed to C<view>, or C<edit> if there were any
  58 errors. A hash of errors will be passed to the template.
  59
  60 =cut
  61
  62 sub do_edit : Exported {
  63   my ($self, $r, $obj) = @_;
  64
  65   my $config   = $r->config;
  66   my $table    = $r->table;
  67
  68   # handle cancel button hit
  69   if ( $r->{params}->{cancel} ) {
  70     $r->template("list");
  71     $r->objects( [$self->retrieve_all] );
  72     return;
  73   }
  74
  75   my $required_cols = $config->{$table}{required_cols} || $self->required_columns;
  76   my $ignored_cols  = $config->{$table}{ignore_cols} || [];
  77
  78   ($obj, my $fatal, my $creating) = $self->_do_update_or_create($r, $obj, $required_cols, $ignored_cols);
  79
  80   # handle errors, if none, proceed to view the newly created/updated object
  81   my %errors = $fatal ? (FATAL => $fatal) : $obj->cgi_update_errors;
  82
  83   if (%errors) {
  84     # Set it up as it was:
  85     $r->template_args->{cgi_params} = $r->params;
  86
  87     # replace user unfriendly error messages with something nicer
  88
  89     foreach (@{$config->{$table}->{required_cols}}) {
  90       next unless ($errors{$_});
  91       my $key = $_;
  92       s/_/ /g;
  93       $r->template_args->{errors}{ucfirst($_)} = 'This field is required, please provide a valid value';
  94       $r->template_args->{errors}{$key} = 'This field is required, please provide a valid value';
  95       delete $errors{$key};
  96     }
  97
  98     foreach (keys %errors) {
  99       my $key = $_;
 100       s/_/ /g;
 101       $r->template_args->{errors}{ucfirst($_)} = 'Please provide a valid value for this field';
 102       $r->template_args->{errors}{$key} = 'Please provide a valid value for this field';
 103     }
 104
 105     undef $obj if $creating;
 106
 107     die "do_update failed with error : $fatal" if ($fatal);
 108     $r->template("edit");
 109   } else {
 110     $r->template("view");
 111   }
 112
 113   $r->objects( $obj ? [$obj] : []);
 114 }
 115
 116 # split out from do_edit to be reported by Mp::P::Trace
 117 sub _do_update_or_create {
 118   my ($self, $r, $obj, $required_cols, $ignored_cols) = @_;
 119
 120   my $fatal;
 121   my $creating = 0;
 122
 123   my $h = $self->Untainter->new( %{$r->params} );
 124
 125   # update or create
 126   if ($obj) {
 127     # We have something to edit
 128     eval { $obj->update_from_cgi( $r => {
 129                                          required => $required_cols,
 130                                          ignore => $ignored_cols,
 131                                         });
 132            $obj->update(); # pos fix for bug 17132 'autoupdate required by do_edit'
 133          };
 134     $fatal = $@;
 135   } else {
 136         eval {
 137         $obj = $self->create_from_cgi( $r => {
 138                                             required => $required_cols,
 139                                             ignore => $ignored_cols,
 140                                            } );
 141         };
 142         $fatal = $@;
 143         $creating++;
 144   }
 145   return $obj, $fatal, $creating;
 146 }
 147
 148 =head2 view
 149
 150 This command shows the object using the view factory template.
 151
 152 =cut
 153
 154 sub view : Exported {
 155   my ($self, $r) = @_;
 156   $r->build_form_elements(0);
 157   return;
 158 }
 159
 160
 161 =head2 delete
 162
 163 Deprecated method that calls do_delete or a given classes delete method, please
 164 use do_delete instead
 165
 166 =head2 do_delete
 167
 168 Unsuprisingly, this command causes a database record to be forever lost.
 169
 170 This method replaces the, now deprecated, delete method provided in prior versions
 171
 172 =cut
 173
 174 sub delete : Exported {
 175   my $self = shift;
 176   my ($sub) = (caller(1))[3];
 177   # So subclasses can still send delete down ...
 178   $sub =~ /^(.+)::([^:]+)$/;
 179   if ($1 ne "Maypole::Model::Base" && $2 ne "delete") {
 180     $self->SUPER::delete(@_);
 181   } else {
 182     warn "Maypole::Model::CDBI::Base delete method is deprecated\n";
 183     $self->do_delete(@_);
 184   }
 185 }
 186
 187
 188 sub do_delete {
 189   my ( $self, $r ) = @_;
 190   # FIXME: handle fatal error with exception
 191   $_->SUPER::delete for @{ $r->objects || [] };
 192 #  $self->dbi_commit;
 193   $r->objects( [ $self->retrieve_all ] );
 194   $r->{template} = "list";
 195   $self->list($r);
 196 }
 197
 198 =head2 search
 199
 200 Deprecated searching method - use do_search instead.
 201
 202 =head2 do_search
 203
 204 This action method searches for database records, it replaces
 205 the, now deprecated, search method previously provided.
 206
 207 =cut
 208
 209 sub search : Exported {
 210   my $self = shift;
 211   my ($sub) = (caller(1))[3];
 212   # So subclasses can still send search down ...
 213   if ($sub =~ /^(.+)::([^:]+)$/) {
 214     return ($1 ne "Maypole::Model::Base" && $2 ne "search") ?
 215       $self->SUPER::search(@_) : $self->do_search(@_);
 216   } else {
 217     $self->SUPER::search(@_);
 218   }
 219 }
 220
 221 sub do_search : Exported {
 222     my ( $self, $r ) = @_;
 223     my %fields = map { $_ => 1 } $self->columns;
 224     my $oper   = "like";                                # For now
 225     my %params = %{ $r->{params} };
 226     my %values = map { $_ => { $oper, $params{$_} } }
 227       grep { defined $params{$_} && length ($params{$_}) && $fields{$_} }
 228       keys %params;
 229
 230     $r->template("list");
 231     if ( !%values ) { return $self->list($r) }
 232     my $order = $self->order($r);
 233     $self = $self->do_pager($r);
 234     $r->objects(
 235         [
 236             $self->search_where(
 237                 \%values, ( $order ? { order_by => $order } : () )
 238             )
 239         ]
 240     );
 241     $r->{template_args}{search} = 1;
 242 }
 243
 244 =head2 list
 245
 246 The C<list> method fills C<$r-E<gt>objects> with all of the
 247 objects in the class. The results are paged using a pager.
 248
 249 =cut
 250
 251 sub list : Exported {
 252     my ( $self, $r ) = @_;
 253     my $order = $self->order($r);
 254     $self = $self->do_pager($r);
 255     if ($order) {
 256         $r->objects( [ $self->retrieve_all_sorted_by($order) ] );
 257     }
 258     else {
 259         $r->objects( [ $self->retrieve_all ] );
 260     }
 261 }
 262
 263 ###############################################################################
 264 # Helper methods
 265
 266 =head1 Helper Methods
 267
 268
 269 =head2 adopt
 270
 271 This class method is passed the name of a model class that represents a table
 272 and allows the master model class to do any set-up required.
 273
 274 =cut
 275
 276 sub adopt {
 277     my ( $self, $child ) = @_;
 278     $child->autoupdate(1);
 279     if ( my $col = $child->stringify_column ) {
 280         $child->columns( Stringify => $col );
 281     }
 282 }
 283
 284
 285 =head2 related
 286
 287 This method returns a list of has-many accessors. A brewery has many
 288 beers, so C<BeerDB::Brewery> needs to return C<beers>.
 289
 290 =cut
 291
 292 sub related {
 293     my ( $self, $r ) = @_;
 294     return keys %{ $self->meta_info('has_many') || {} };
 295 }
 296
 297
 298 =head2 related_class
 299
 300 Given an accessor name as a method, this function returns the class this accessor returns.
 301
 302 =cut
 303
 304 sub related_class {
 305      my ( $self, $r, $accessor ) = @_;
 306      my $meta = $self->meta_info;
 307      my @rels = keys %$meta;
 308      my $related;
 309      foreach (@rels) {
 310          $related = $meta->{$_}{$accessor};
 311          last if $related;
 312      }
 313      return unless $related;
 314
 315      my $mapping = $related->{args}->{mapping};
 316      if ( $mapping and @$mapping ) {
 317        return $related->{foreign_class}->meta_info('has_a')->{$$mapping[0]}->{foreign_class};
 318      }
 319      else {
 320          return $related->{foreign_class};
 321      }
 322  }
 323
 324 =head2 related_meta
 325
 326   $class->related_meta($col);
 327
 328 Returns the hash ref of relationship meta info for a given column.
 329
 330 =cut
 331
 332 sub related_meta {
 333     my ($self,$r, $accssr) = @_;
 334     $self->_croak("You forgot to put the place holder for 'r' or forgot the accssr parameter") unless $accssr;
 335     my $class_meta = $self->meta_info;
 336     if (my ($rel_type) = grep { defined $class_meta->{$_}->{$accssr} }
 337         keys %$class_meta)
 338     { return  $class_meta->{$rel_type}->{$accssr} };
 339 }
 340
 341
 342
 343 =head2 stringify_column
 344
 345    Returns the name of the column to use when stringifying
 346    and object.
 347
 348 =cut
 349
 350 sub stringify_column {
 351     my $class = shift;
 352     return (
 353         $class->columns("Stringify"),
 354         ( grep { /^(name|title)$/i } $class->columns ),
 355         ( grep { /(name|title)/i } $class->columns ),
 356         ( grep { !/id$/i } $class->primary_columns ),
 357     )[0];
 358 }
 359
 360 =head2 do_pager
 361
 362    Sets the pager template argument ($r->{template_args}{pager})
 363    to a Class::DBI::Pager object based on the rows_per_page
 364    value set in the configuration of the application.
 365
 366    This pager is used via the pager macro in TT Templates, and
 367    is also accessible via Mason.
 368
 369 =cut
 370
 371 sub do_pager {
 372     my ( $self, $r ) = @_;
 373     if ( my $rows = $r->config->rows_per_page ) {
 374         return $r->{template_args}{pager} =
 375           $self->pager( $rows, $r->query->{page} );
 376     }
 377     else { return $self }
 378 }
 379
 380
 381 =head2 order
 382
 383     Returns the SQL order syntax based on the order parameter passed
 384     to the request, and the valid columns.. i.e. 'title ASC' or 'date_created DESC'.
 385
 386     $sql .= $self->order($r);
 387
 388     If the order column is not a column of this table,
 389     or an order argument is not passed, then the return value is undefined.
 390
 391     Note: the returned value does not start with a space.
 392
 393 =cut
 394
 395 sub order {
 396     my ( $self, $r ) = @_;
 397     my %ok_columns = map { $_ => 1 } $self->columns;
 398     my $q = $r->query;
 399     my $order = $q->{order};
 400     return unless $order and $ok_columns{$order};
 401     $order .= ' DESC' if $q->{o2} and $q->{o2} eq 'desc';
 402     return $order;
 403 }
 404
 405
 406 =head2 fetch_objects
 407
 408 Returns 1 or more objects of the given class when provided with the request
 409
 410 =cut
 411
 412 sub fetch_objects {
 413     my ($class, $r)=@_;
 414     my @pcs = $class->primary_columns;
 415     if ( $#pcs ) {
 416     my %pks;
 417         @pks{@pcs}=(@{$r->{args}});
 418         return $class->retrieve( %pks );
 419     }
 420     return $class->retrieve( $r->{args}->[0] );
 421 }
 422
 423
 424 =head2 _isa_class
 425
 426 Private method to return the class a column
 427 belongs to that was inherited by an is_a relationship.
 428 This should probably be public but need to think of API
 429
 430 =cut
 431
 432 sub _isa_class {
 433     my ($class, $col) = @_;
 434     $class->_croak( "Need a column for _isa_class." ) unless $col;
 435     my $isaclass;
 436     my $isa = $class->meta_info("is_a") || {};
 437     foreach ( keys %$isa ) {
 438         $isaclass = $isa->{$_}->foreign_class;
 439         return $isaclass if ($isaclass->find_column($col));
 440     }
 441     return; # col not in a is_a class
 442 }
 443
 444
 445 # Thanks to dave baird --  form builder for these private functions
 446 # sub _column_info {
 447 sub _column_info {
 448   my $self = shift;
 449   my $dbh = $self->db_Main;
 450
 451   my $meta;                     # The info we are after
 452   my ($catalog, $schema) = (undef, undef);
 453   # Dave is suspicious this (above undefs) could
 454   # break things if driver useses this info
 455
 456   my $original_metadata;
 457   # '%' is a search pattern for columns - matches all columns
 458   if ( my $sth = $dbh->column_info( $catalog, $schema, $self->table, '%' ) ) {
 459     $dbh->errstr && die "Error getting column info sth: " . $dbh->errstr;
 460     $self->COLUMN_INFO ($self->_hash_type_meta( $sth ));
 461   } else {
 462     $self->COLUMN_INFO ($self->_hash_typeless_meta( ));
 463   }
 464
 465   return $self->COLUMN_INFO;
 466 }
 467
 468 sub _hash_type_meta {
 469   my ($self, $sth) = @_;
 470   my $meta;
 471   while ( my $row = $sth->fetchrow_hashref ) {
 472     my $colname = $row->{COLUMN_NAME} || $row->{column_name};
 473
 474     # required / nullable
 475     $meta->{$colname}{nullable} = $row->{NULLABLE};
 476     $meta->{$colname}{required} = ( $meta->{$colname}{nullable} == 0 ) ? 1 : 0;
 477
 478     # default
 479     if (defined $row->{COLUMN_DEF}) {
 480       my $default = $row->{COLUMN_DEF};
 481       $default =~ s/['"]?(.*?)['"]?::.*$/$1/;
 482       $meta->{$colname}{default} = $default;
 483     }else {
 484       $meta->{$colname}{default} = '';
 485     }
 486
 487     # type
 488     my $type = $row->{mysql_type_name} || $row->{type};
 489     unless ($type) {
 490       $type =  $row->{TYPE_NAME};
 491       if ($row->{COLUMN_SIZE}) {
 492         $type .= "($row->{COLUMN_SIZE})";
 493       }
 494     }
 495     $type =~ s/['"]?(.*)['"]?::.*$/$1/;
 496     # Bool if tinyint
 497     if ($type and $type =~ /^tinyint/i and $row->{COLUMN_SIZE} == 1) {
 498       $type = 'BOOL';
 499     }
 500     $meta->{$colname}{type} = $type;
 501
 502     # order
 503     $meta->{$colname}{position} = $row->{ORDINAL_POSITION}
 504   }
 505   return $meta;
 506 }
 507
 508 # typeless db e.g. sqlite
 509 sub _hash_typeless_meta {
 510   my ( $self ) = @_;
 511
 512   $self->set_sql( fb_meta_dummy => 'SELECT * FROM __TABLE__ WHERE 1=0' )
 513     unless $self->can( 'sql_fb_meta_dummy' );
 514
 515   my $sth = $self->sql_fb_meta_dummy;
 516
 517   $sth->execute or die "Error executing column info: "  . $sth->errstr;;
 518
 519   # see 'Statement Handle Attributes' in the DBI docs for a list of available attributes
 520   my $cols  = $sth->{NAME};
 521   my $types = $sth->{TYPE};
 522   # my $sizes = $sth->{PRECISION};    # empty
 523   # my $nulls = $sth->{NULLABLE};     # empty
 524
 525   # we haven't actually fetched anything from the sth, so need to tell DBI we're not going to
 526   $sth->finish;
 527
 528   my $order = 0;
 529   my $meta;
 530   foreach my $col ( @$cols ) {
 531     my $col_meta;
 532     $col_meta->{nullable}    = 1;
 533     $col_meta->{required}    = 0;
 534     $col_meta->{default}     = '';
 535     $col_meta->{position} = $order++;
 536     # type_name is taken literally from the schema, but is not actually used by sqlite,
 537     # so it can be anything, e.g. varchar or varchar(xxx) or VARCHAR etc.
 538     my $type = shift( @$types );
 539     $col_meta->{type} = ($type =~ /(\w+)\((\w+)\)/) ? $1 :$type ;
 540     $meta->{$col} = $col_meta;
 541   }
 542   return $meta;
 543 }
 544
 545 =head2 column_type
 546
 547     my $type = $class->column_type('column_name');
 548
 549 This returns the 'type' of this column (VARCHAR(20), BIGINT, etc.)
 550 For now, it returns "BOOL" for tinyints.
 551
 552 TODO :: TEST with enums
 553
 554 =cut
 555
 556 sub column_type {
 557   my $class = shift;
 558   my $colname = shift or die "Need a column for column_type";
 559   $class->_column_info() unless (ref $class->COLUMN_INFO);
 560
 561   if ($class->_isa_class($colname)) {
 562     return $class->_isa_class($colname)->column_type($colname);
 563   }
 564   unless ( $class->find_column($colname) ) {
 565     warn "$colname is not a recognised column in this class ", ref $class || $class, "\n";
 566     return undef;
 567   }
 568   return $class->COLUMN_INFO->{$colname}{type};
 569 }
 570
 571 =head2 required_columns
 572
 573   Accessor to get/set required columns for forms, validation, etc.
 574
 575   Returns list of required columns. Accepts an array ref of column names.
 576
 577   $class->required_columns([qw/foo bar baz/]);
 578
 579   Allows you to specify the required columns for a class, over-riding any
 580   assumptions and guesses made by Maypole.
 581
 582   Any columns specified as required will no longer be 'nullable' or optional, and
 583   any columns not specified as 'required' will be 'nullable' or optional.
 584
 585   The default for a column is nullable, or whatever is discovered from database
 586   schema.
 587
 588   Use this instead of $config->{$table}{required_cols}
 589
 590   Note : you need to setup the model class before calling this method.
 591
 592 =cut
 593
 594 sub required_columns {
 595   my ($class, $columns) = @_;
 596   $class->_column_info() unless (ref $class->COLUMN_INFO);
 597   my $column_info = $class->COLUMN_INFO;
 598
 599   if ($columns) {
 600     # get the previously required columns
 601     my %previously_required = map { $_ => 1} grep($column_info->{$_}{required}, keys %$column_info);
 602
 603     # update each specified column as required
 604     foreach my $colname ( @$columns ) {
 605       # handle C::DBI::Rel::IsA
 606       if ($class->_isa_class($colname)) {
 607         $class->_isa_class($colname)->COLUMN_INFO->{$colname}{required} = 1
 608           unless ($class->_isa_class($colname)->column_required);
 609         next;
 610       }
 611       unless ( $class->find_column($colname) ) {
 612         warn "$colname is not a recognised column in this class ", ref $class || $class, "\n";
 613         next;
 614       }
 615       $column_info->{$colname}{required} = 1;
 616       delete $previously_required{$colname};
 617     }
 618
 619     # no longer require any columns not specified
 620     foreach my $colname ( keys %previously_required ) {
 621       $column_info->{$colname}{required} = 0;
 622       $column_info->{$colname}{nullable} = 1;
 623     }
 624
 625     # update column metadata
 626     $class->COLUMN_INFO($column_info);
 627   }
 628
 629   return [ grep ($column_info->{$_}{required}, keys %$column_info) ] ;
 630 }
 631
 632 =head2 column_required
 633
 634   Returns true if a column is required
 635
 636   my $required = $class->column_required($column_name);
 637
 638   Columns can be required by the application but not the database, but not the other way around,
 639   hence there is also a column_nullable method which will tell you if the column is nullable
 640   within the database itself.
 641
 642 =cut
 643
 644 sub column_required {
 645   my ($class, $colname) = @_;
 646   $colname or $class->_croak( "Need a column for column_required" );
 647   $class->_column_info() unless ref $class->COLUMN_INFO;
 648   if ($class->_isa_class($colname)) {
 649     return $class->_isa_class($colname)->column_required($colname);
 650   }
 651   unless ( $class->find_column($colname) ) {
 652     # handle  non-existant columns
 653     warn "$colname is not a recognised column in this class ", ref $class || $class, "\n";
 654     return undef;
 655   }
 656   return $class->COLUMN_INFO->{$colname}{required} if ($class->COLUMN_INFO and $class->COLUMN_INFO->{$colname});
 657   return  0;
 658 }
 659
 660 =head2 column_nullable
 661
 662   Returns true if a column can be NULL within the underlying database and false if not.
 663
 664   my $nullable = $class->column_nullable($column_name);
 665
 666   Any columns that are not nullable will automatically be specified as required, you can
 667   also specify nullable columns as required within your application.
 668
 669   It is recomended you use column_required rather than column_nullable within your
 670   application, this method is more useful if extending the model or handling your own
 671   validation.
 672
 673 =cut
 674
 675 sub column_nullable {
 676     my $class = shift;
 677     my $colname = shift or $class->_croak( "Need a column for column_nullable" );
 678
 679   $class->_column_info() unless ref $class->COLUMN_INFO;
 680   if ($class->_isa_class($colname)) {
 681     return $class->_isa_class($colname)->column_nullable($colname);
 682   }
 683   unless ( $class->find_column($colname) ) {
 684     # handle  non-existant columns
 685     warn "$colname is not a recognised column in this class ", ref $class || $class, "\n";
 686     return undef;
 687   }
 688   return $class->COLUMN_INFO->{$colname}{nullable} if ($class->COLUMN_INFO and $class->COLUMN_INFO->{$colname});
 689   return  0;
 690 }
 691
 692 =head2 column_default
 693
 694 Returns default value for column or the empty string.
 695 Columns with NULL, CURRENT_TIMESTAMP, or Zeros( 0000-00...) for dates and times
 696 have '' returned.
 697
 698 =cut
 699
 700 sub column_default {
 701   my $class = shift;
 702   my $colname = shift or $class->_croak( "Need a column for column_default");
 703   $class->_column_info() unless (ref $class->COLUMN_INFO);
 704   if ($class->_isa_class($colname)) {
 705     return $class->_isa_class($colname)->column_default($colname);
 706   }
 707   unless ( $class->find_column($colname) ) {
 708     warn "$colname is not a recognised column in this class ", ref $class || $class, "\n";
 709     return undef;
 710   }
 711
 712   return $class->COLUMN_INFO->{$colname}{default} if ($class->COLUMN_INFO and $class->COLUMN_INFO->{$colname});
 713   return;
 714 }
 715
 716 =head2 get_classmetadata
 717
 718 Gets class meta data *excluding cgi input* for the passed in class or the
 719 calling class. *NOTE* excludes cgi inputs. This method is handy to call from
 720 templates when you need some metadata for a related class.
 721
 722 =cut
 723
 724 sub get_classmetadata {
 725     my ($self, $class) = @_; # class is class we want data for
 726     $class ||= $self;
 727     $class = ref $class || $class;
 728
 729     my %res;
 730     $res{name}          = $class;
 731     $res{colnames}      = {$class->column_names};
 732     $res{columns}       = [$class->display_columns];
 733     $res{list_columns}  = [$class->list_columns];
 734     $res{moniker}       = $class->moniker;
 735     $res{plural}        = $class->plural_moniker;
 736     $res{table}         = $class->table;
 737     $res{column_metadata} = (ref $class->COLUMN_INFO) ? $class->COLUMN_INFO : $class->_column_info() ;
 738     return \%res;
 739 }
 740
 741
 742 =head1 SEE ALSO
 743
 744 L<Maypole>, L<Maypole::Model::CDBI::Base>.
 745
 746 =head1 AUTHOR
 747
 748 Maypole is currently maintained by Aaron Trevena.
 749
 750 =head1 AUTHOR EMERITUS
 751
 752 Simon Cozens, C<simon#cpan.org>
 753
 754 Simon Flack maintained Maypole from 2.05 to 2.09
 755
 756 Sebastian Riedel, C<sri#oook.de> maintained Maypole from 1.99_01 to 2.04
 757
 758 =head1 LICENSE
 759
 760 You may distribute this code under the same terms as Perl itself.
 761
 762 =cut
 763
 764 1;