From 0e62abcbcaa42ab927cc252bd96b3a0e2e1a0408 Mon Sep 17 00:00:00 2001 From: Aaron Trevena Date: Sun, 5 Feb 2006 16:46:55 +0000 Subject: [PATCH] some documentation improvements, some test fixes git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@453 48953598-375a-da11-a14b-00016c27c3ee --- lib/Maypole.pm | 32 ++++++++---- lib/Maypole/Model/CDBI.pm | 46 ++++++++++++++++- lib/Maypole/Model/CDBI/AsForm.pm | 88 +++++++++++--------------------- lib/Maypole/Model/CDBI/Plain.pm | 56 ++++++++++---------- t/01.httpd-basic.t | 11 ++-- 5 files changed, 136 insertions(+), 97 deletions(-) diff --git a/lib/Maypole.pm b/lib/Maypole.pm index 3fcfd15..fe2d29a 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -253,7 +253,7 @@ Some packages respond to higher debug levels, try increasing it to 2 or 3. =cut -sub debug { 0 } +sub debug { 0 } =item config @@ -261,20 +261,34 @@ Returns the L object =item setup - My::App->setup($data_source, $user, $password, \%attr); - -Initialise the Maypole application and plugins and model classes - see -L. - -If your model is based on L, the C<\%attr> hashref can -contain options that are passed directly to L, to control -how the model hierarchy is constructed. + My::App->setup($data_source, $user, $password, \%attr); +Initialise the Maypole application and plugins and model classes. Your application should call this B setting up configuration data via L<"config">. +It calls the hook C to setup the model. The %attr hash contains +options and arguments used to set up the model. See the particular model's +documentation. However here is the most usage of setup where +Maypole::Model::CDBI is the base class. + + My::App->setup($data_source, $user, $password, + { opitons => { # These are DB connection options + AutoCommit => 0, + RaiseError => 1, + ... + }, + # These are Class::DBI::Loader arguments. + relationships => 1, + ... + } + ); + +Also, see L. + =cut + sub setup { my $class = shift; diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 4423b69..5013d4f 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -16,6 +16,11 @@ It implements a base set of methods required for a Maypole Data Model. It inherits accessor and helper methods from L. +When specified as the application model, it will use Class::DBI::Loader +to generate the model classes from the provided database. If you do not +wish to use this functionality, use L which +will instead use Class::DBI classes provided. + =cut use base qw(Maypole::Model::Base Class::DBI); @@ -38,7 +43,7 @@ use attributes (); Action methods are methods that are accessed through web (or other public) interface. -=item do_edit +=head2 do_edit If there is an object in C<$r-Eobjects>, then it should be edited with the parameters in C<$r-Eparams>; otherwise, a new object should @@ -441,6 +446,9 @@ sub accessor_classes { =head2 stringify_column + Returns the name of the column to use when stringifying + and object. + =cut sub stringify_column { @@ -455,6 +463,13 @@ sub stringify_column { =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 sub do_pager { @@ -469,6 +484,16 @@ sub do_pager { =head2 order + Returns the SQL order syntax based on the order parameter passed + to the request, and the valid columns.. i.e. 'title ASC' or 'date_created DESC'. + + $sql .= $self->order($r); + + If the order column is not a column of this table, + or an order argument is not passed, then the return value is undefined. + + Note: the returned value does not start with a space. + =cut sub order { @@ -481,8 +506,27 @@ sub order { return $order; } +=head2 setup + + This method is inherited from Maypole::Model::Base and calls setup_database, + which uses Class::DBI::Loader to create and load Class::DBI classes from + the given database schema. + +=cut + =head2 setup_database +The $opts argument is a hashref of options. The "options" key is a hashref of +Database connection options . Other keys may be various Loader arguments or +flags. It has this form: + { + # DB connection options + options { AutoCommit => 1 , ... }, + # Loader args + relationships => 1, + ... + } + =cut sub setup_database { diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm index 39cda98..e0cd7f2 100644 --- a/lib/Maypole/Model/CDBI/AsForm.pm +++ b/lib/Maypole/Model/CDBI/AsForm.pm @@ -24,32 +24,7 @@ our @EXPORT = _select_guts unselect_element search_inputs make_param_foreign ); -our $VERSION = '.09'; - -# 11-05-05 - added _to_link_hidden to make a link to the hidden object -# - fixed _to_hidden when called with no args. Hides self obj. -# 11-04-05 - _to_textfield: tries to call "deflate4edit" if column is has_a -# 11-08-05 - Changed Version to .08 - - - -# 1-10-06 -- fixed bug in to_textfiled that was stringifyingf CDBI objects -# # -# -# 1-20-06 - to_select - call db_Main with has a class. -# 1-24-06 - to_select_from_many now named _to_select_from_many . Old deprecated -# - hasmany_class removed in favor of model's related_class method. -# - took out do_select. That is a model action. -# - use search_columns instead of search_fields now. -# - use to_field('column', 'select', {args}) instead of a_select_box. -# -- took out make_hidden_element.was my own personal hack -# -- added _box from DH's FormView to calculate decent textarea size -# -- Refactor to_field into _from_* method calls. -# -# 1-25-06 -- Added _to_checkbox and _to_radio from FView -# 1-27-06 -- Refactored into yet more exported methods -# 1-28-06 -- select constraints where, join order by - +our $VERSION = '2.11'; =head1 NAME @@ -334,32 +309,31 @@ Override at will. =cut sub _field_from_column { - my ($self, $field, $args) = @_; - my $class = ref $self || $self; - # Get column type - unless ($args->{column_type}) { - if ($class->can('column_type')) { - $args->{column_type} = $class->column_type($field); - } - else { - # Right, have some of this - eval "package $class; Class::DBI::Plugin::Type->import()"; - $args->{column_type} = $class->column_type($field); - } + my ($self, $field, $args) = @_; + my $class = ref $self || $self; + # Get column type + unless ($args->{column_type}) { + if ($class->can('column_type')) { + $args->{column_type} = $class->column_type($field); + } else { + # Right, have some of this + eval "package $class; Class::DBI::Plugin::Type->import()"; + $args->{column_type} = $class->column_type($field); } - my $type = $args->{column_type}; - - return $self->_to_textfield($field) - if $type and $type =~ /(VAR)?CHAR/i; #common type - return $self->_to_textarea($field, $args) - if $type and $type =~ /^(TEXT|BLOB)$/i; - return $self->_to_enum_select($field, $args) - if $type and $type =~ /^ENUM\((.*?)\)$/i; - return $self->_to_bool_select($field, $args) - if $type and $type =~ /^BOOL/i; - return $self->_to_readonly($field, $args) - if $type and $type =~ /^readonly$/i; - return; + } + my $type = $args->{column_type}; + + return $self->_to_textfield($field) + if $type and $type =~ /(VAR)?CHAR/i; #common type + return $self->_to_textarea($field, $args) + if $type and $type =~ /^(TEXT|BLOB)$/i; + return $self->_to_enum_select($field, $args) + if $type and $type =~ /^ENUM\((.*?)\)$/i; + return $self->_to_bool_select($field, $args) + if $type and $type =~ /^BOOL/i; + return $self->_to_readonly($field, $args) + if $type and $type =~ /^readonly$/i; + return; } @@ -993,17 +967,15 @@ sub _options_from_hashes { my $fclass = $args->{class} || ''; my $stringify = $args->{stringify} || ''; my @res; - for (@$items) { - my $val = $_->{$pk}; + for my $item (@$items) { + my $val = $item->{$pk}; my $opt = HTML::Element->new("option", value => $val ); $opt->attr(selected => "selected") if $selected->{$val}; - my $content = $fclass and $stringify and $fclass->can($stringify) ? - $fclass->$stringify($_) : - join(' ', @$_); + my $content = ( $fclass && $stringify && $fclass->can($stringify)) ? $fclass->$stringify($item) : join(' ', @$item); $opt->push_content( $content ); - push @res, $opt; + push @res, $opt; } - return @res; + return @res; } # diff --git a/lib/Maypole/Model/CDBI/Plain.pm b/lib/Maypole/Model/CDBI/Plain.pm index 9f149ed..7a36f68 100644 --- a/lib/Maypole/Model/CDBI/Plain.pm +++ b/lib/Maypole/Model/CDBI/Plain.pm @@ -5,27 +5,6 @@ use strict; Maypole::Config->mk_accessors(qw(table_to_class)); - - -sub setup_database { - my ( $self, $config, $namespace, $classes ) = @_; - $config->{classes} = $classes; - foreach my $class (@$classes) { $namespace->load_model_subclass($class); } - $namespace->model_classes_loaded(1); - $config->{table_to_class} = { map { $_->table => $_ } @$classes }; - $config->{tables} = [ keys %{ $config->{table_to_class} } ]; -} - -sub class_of { - my ( $self, $r, $table ) = @_; - return $r->config->{table_to_class}->{$table}; -} - - - - -1; - =head1 NAME Maypole::Model::CDBI::Plain - Class::DBI model without ::Loader @@ -47,15 +26,40 @@ tables and set up the inheritance relationships as normal. =head1 METHODS -=over 4 +=head2 setup -=item setup_database + This method is inherited from Maypole::Model::Base and calls setup_database, + which uses Class::DBI::Loader to create and load Class::DBI classes from + the given database schema. -=item class_of +=head2 setup_database -=back + This method loads the model classes for the application -See L +=head1 SEE ALSO + +L + +L =cut + +sub setup_database { + my ( $self, $config, $namespace, $classes ) = @_; + $config->{classes} = $classes; + foreach my $class (@$classes) { $namespace->load_model_subclass($class); } + $namespace->model_classes_loaded(1); + $config->{table_to_class} = { map { $_->table => $_ } @$classes }; + $config->{tables} = [ keys %{ $config->{table_to_class} } ]; +} + +sub class_of { + my ( $self, $r, $table ) = @_; + return $r->config->{table_to_class}->{$table}; +} + + +1; + + diff --git a/t/01.httpd-basic.t b/t/01.httpd-basic.t index fe32351..cbf62d5 100644 --- a/t/01.httpd-basic.t +++ b/t/01.httpd-basic.t @@ -1,5 +1,10 @@ use Test::More tests=>2; - -use_ok("Maypole::HTTPD"); -use_ok("Maypole::HTTPD::Frontend"); +SKIP: { + no warnings 'all'; + my $have_httpd = eval ' use HTTP::Server::Simple::Static; $HTTP::Server::Simple::Static::VERSION; '; + warn "have_httpd : $have_httpd\n"; + skip ('Maypole::HTTPD tests', 2) unless ( $have_httpd ); + use_ok("Maypole::HTTPD"); + use_ok("Maypole::HTTPD::Frontend"); +}; -- 2.39.2