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