Maypole-2.111.tar.gz

diff --git a/Changes b/Changes
index c4cc7dbfccdd4990685c1d25cc31f106b9035d42..3f69490a406c9789826ef0bdb2969e43199dc40b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,6 +2,18 @@ This file documents the revision history for Perl extension Maypole.
 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

diff --git a/META.yml b/META.yml
index 0ead8dd6c9bbcf0bfd3ff47f1a4fefbae71b2e5f..6fd72b67a3c696ee1f67eea72cb5eae60943e6c8 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -1,7 +1,7 @@
 # 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:

diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm
index e604998617e7ae7cf493faa40900881e54090380..4d32dc43f6d260048ae47e5e41eb719728c8d9ac 100644 (file)
--- a/lib/Apache/MVC.pm
+++ b/lib/Apache/MVC.pm
@@ -142,8 +142,7 @@ sub parse_args {
 
 =cut
 
-sub redirect_request
-{
+sub redirect_request {
   my $r = shift;
   my $redirect_url = $_[0];
   my $status = $MODPERL2 ? eval 'Apache2::Const::REDIRECT;' :
@@ -156,7 +155,11 @@ sub redirect_request
       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});
   }

diff --git a/lib/Maypole.pm b/lib/Maypole.pm
index d476b56a46e55ed9dad22695f8a10e33b9e0db5d..211bd056a007d4505351bee182ccb941ce2cace4 100644 (file)
--- a/lib/Maypole.pm
+++ b/lib/Maypole.pm
@@ -12,7 +12,7 @@ use URI::QueryParam;
 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:

diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm
index ce93690d065c86d99ea98214ed2ab63852b15287..e15745b08f613eca147ae6aa8c63d4d7f738892d 100644 (file)
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -137,7 +137,7 @@ sub _do_update_or_create {
   # 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,
                                        }); 
@@ -146,7 +146,7 @@ sub _do_update_or_create {
     $fatal = $@;
   } else {
        eval {
-       $obj = $self->create_from_cgi( $r => {
+       $obj = $self->create_from_cgi( $h => {
                                            required => $required_cols,
                                            ignore => $ignored_cols,
                                           } );

diff --git a/lib/Maypole/View/TT.pm b/lib/Maypole/View/TT.pm
index b7a59a2f565813c9a5c3c4a7ffaee12d845ac232..2d1d60fcfe228376df8b2f592674e619c7f3c1f2 100644 (file)
--- a/lib/Maypole/View/TT.pm
+++ b/lib/Maypole/View/TT.pm
@@ -3,16 +3,24 @@ use base 'Maypole::View::Base';
 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,
@@ -34,11 +42,13 @@ sub template {
     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;
   }
@@ -49,20 +59,21 @@ sub report_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
@@ -420,6 +431,11 @@ the path "[% request.path %]". The error text returned was:
     <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>

diff --git a/lib/Maypole/templates/factory/edit b/lib/Maypole/templates/factory/edit
index 2016bb1215f2cce7b0776c1bae4fce8344de4d33..3b0aca635d6b0a569f0ed32601a0fedbdca8e072 100644 (file)
--- a/lib/Maypole/templates/factory/edit
+++ b/lib/Maypole/templates/factory/edit
@@ -18,7 +18,7 @@ form similar to L<addnew> but with the current values filled in.
 
 [% 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;

diff --git a/lib/Maypole/templates/factory/macros b/lib/Maypole/templates/factory/macros
index c96cb17db8d7818e23b0a04efbbf5273083bd8ce..8267d926de4a157445a6934dccab74163625fee3 100644 (file)
--- a/lib/Maypole/templates/factory/macros
+++ b/lib/Maypole/templates/factory/macros
@@ -14,7 +14,7 @@ catenating the base URL, table, command, and any arguments.
 [%
 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>";

diff --git a/t/db_colinfo.t b/t/db_colinfo.t
index 2b341eb699c1a6e279ce2c25b2c253c8da47c390..41c95a61bd4245af8072a6384ed759e7ea2d54c2 100755 (executable)
--- a/t/db_colinfo.t
+++ b/t/db_colinfo.t
@@ -1,9 +1,17 @@
 #!/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';
@@ -130,10 +138,10 @@ SKIP: {
        }
 
        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)" );