For information about current developments and future releases, see:
http://maypole.perl.org/?TheRoadmap
+2.111 Sat 21 April 2007
+
+Fixes :
+ Fixed typo in edit form template
+ Fixed extra html filter in link macro in factory templates
+ Fixed typo in _do_update_or_create (bug 26495)
+ fix to display_line macro in factory templates (bug 22920)
+ fixed template path with array refs
+ fixed redirect_request
+ fixed db_colinfo.t test when no mysql
+
+
2.11 Mon 31 July 2006
SVN revision 519
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Maypole
-version: 2.11
+version: 2.111
version_from: lib/Maypole.pm
installdirs: site
requires:
=cut
-sub redirect_request
-{
+sub redirect_request {
my $r = shift;
my $redirect_url = $_[0];
my $status = $MODPERL2 ? eval 'Apache2::Const::REDIRECT;' :
my $path = $args{path} || $r->path;
my $host = $args{domain} || $r->ar->hostname;
my $protocol = $args{protocol} || $r->get_protocol;
- $redirect_url = "${protocol}://${host}/${path}";
+
+ $redirect_url = URI->new;
+ $redirect_url->scheme($protocol);
+ $redirect_url->host($host);
+ $redirect_url->path($path);
}
$status = $args{status} if ($args{status});
}
use NEXT;
use File::MMagic::XS qw(:compat);
-our $VERSION = '2.11';
+our $VERSION = '2.111';
our $mmagic = File::MMagic::XS->new();
# proposed privacy conventions:
# update or create
if ($obj) {
# We have something to edit
- eval { $obj->update_from_cgi( $r => {
+ eval { $obj->update_from_cgi( $h => {
required => $required_cols,
ignore => $ignored_cols,
});
$fatal = $@;
} else {
eval {
- $obj = $self->create_from_cgi( $r => {
+ $obj = $self->create_from_cgi( $h => {
required => $required_cols,
ignore => $ignored_cols,
} );
use Maypole::Constants;
use Template;
use File::Spec::Functions qw(catdir tmpdir);
+use Template::Constants qw( :all );
-our $error_template;
+our $error_template;
{ local $/; $error_template = <DATA>; }
+our $VERSION = '2.111';
+
+my $debug_flags = DEBUG_ON;
+
use strict;
sub template {
my ( $self, $r ) = @_;
unless ($self->{tt}) {
my $view_options = $r->config->view_options || {};
+ if ($r->debug) {
+ $view_options->{DEBUG} = $debug_flags;
+ }
$self->{provider} = Template::Provider->new($view_options);
$self->{tt} = Template->new({
%$view_options,
return OK;
} else {
if ($@) {
- warn "fatal error in template '$template_file' : $@\n";
- $r->{error} = "fatal error in template '$template_file' : $@";
+ my $error = "fatal error in template '$template_file' : $@\nTT paths : " . join(', ',$self->paths($r)) . "\n";
+ $r->warn($error);
+ $r->{error} = $error;
} else {
- warn "TT error for template '$template_file'\n" . $self->{tt}->error;
- $r->{error} = "TT error for template '$template_file'\n" . $self->{tt}->error;
+ my $error = "TT error for template '$template_file'\n" . $self->{tt}->error . "\nTT paths : " . join(', ',$self->paths($r)) . "\n";
+ $r->warn($error);
+ $r->{error} = $error;
}
return ERROR;
}
my ($self, $r, $error, $type) = @_;
my $output;
- warn "self : $self, r : $r, error : $error, type : $type\n";
-
# Need to be very careful here.
my $tt = Template->new;
unless (ref $r->{config}) {
- warn "no config for this request\n";
+ $r->warn("no config for this request");
$error .= '<br> There was a problem finding configuration for this request';
$r->{config} ||= {};
}
+
+ $r->warn("report_error - reporting error to user : $error\n");
+
if ($tt->process(\$error_template,
{ err_type => $type, error => $error,
config => $r->{config},
request => $r,
- paths => $self->paths($r),
+ paths => [ $self->paths($r) ],
eval{$self->vars($r)} }, \$output )) {
$r->{output} = $output;
if ($tt->error) { $r->{output} = "<html><body>Even the error template
<tr> <td class="lhs" width="35%"> <b>[% attribute %]</b> </td> <td class="rhs" width="65%"> [%
request.$attribute.list.join(" , ") %] </td></tr>
[% END %]
+ <tr><td colspan="2"></tr>
+ <tr><td class="lhs" colspan="2"><b>CGI Parameters</b> </td></tr>
+ [% FOREACH param IN request.params %]
+ <tr> <td class="lhs" width="35%">[% param.key %]</td> <td class="rhs" width="65%"> [% param.value %] </td></tr>
+ [% END %]
</table>
<h2> Website / Template Paths </h2>
[% IF object %]
<div id="title">Edit a [% classmetadata.moniker %]</div>
-<form action="[% base %]/[% item.table %]/do_edit/[% item.id %]" method="post">
+<form action="[% base %]/[% object.table %]/do_edit/[% object.id %]" method="post">
<fieldset>
<legend>Edit [% object.name %]</legend>
[% FOR col = classmetadata.columns;
[%
MACRO link(table, command, additional, label) BLOCK;
SET lnk = base _ "/" _ table _ "/" _ command _ "/" _ additional;
- lnk = lnk | uri | html;
+ lnk = lnk | uri ;
'<a href="' _ lnk _ '">';
label | html;
"</a>";
#!/usr/bin/perl -w
use Test::More;
use Data::Dumper;
-use lib 'ex'; # Where BeerDB should live
+use DBI;
+use lib 'examples'; # Where BeerDB should live
BEGIN {
- plan tests => 65;
+ my $drh = eval {
+ DBI->install_driver("mysql");
+ my @databases = DBI->data_sources("mysql");
+ die "couldn't connect to mysql" unless (@databases);
+ };
+ warn "error : $@ \n" if ($@);
+ my $testcount = ($@) ? 45 : 65 ;
+ plan tests => $testcount;
}
$db = 'test';
}
foreach my $colname (keys %correct_nullables) {
- ok( $DB_Class->column_required($colname) == !$correct_nullables{$colname}, "nullable column $colname is required (via column_required)" )
+ ok( $DB_Class->column_required($colname) == !$correct_nullables{$colname}, "nullable column $colname is required (via column_required)" )
}
- ok($DB_Class->required_columns([qw/score/]), 'set required column(s)');
+ ok($DB_Class->required_columns([qw/style name tasted score/]), 'set required column(s)');
foreach my $colname ( @{$DB_Class->required_columns()} ) {
ok($correct_nullables{$colname} == 0 || $colname eq 'score',"nullable or required column $colname is required (via required_columns)" );