From dd369c8a18080c4f27237f23b5842d53da05f570 Mon Sep 17 00:00:00 2001
From: Ben Hutchings <ben@decadent.org.uk>
Date: Tue, 4 Nov 2008 03:20:51 +0000
Subject: [PATCH] Maypole-2.111.tar.gz

---
 Changes                              | 12 ++++++++++
 META.yml                             |  2 +-
 lib/Apache/MVC.pm                    |  9 +++++---
 lib/Maypole.pm                       |  2 +-
 lib/Maypole/Model/CDBI.pm            |  4 ++--
 lib/Maypole/View/TT.pm               | 34 ++++++++++++++++++++--------
 lib/Maypole/templates/factory/edit   |  2 +-
 lib/Maypole/templates/factory/macros |  2 +-
 t/db_colinfo.t                       | 16 +++++++++----
 9 files changed, 61 insertions(+), 22 deletions(-)

diff --git a/Changes b/Changes
index c4cc7db..3f69490 100644
--- 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 0ead8dd..6fd72b6 100644
--- 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 e604998..4d32dc4 100644
--- 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 d476b56..211bd05 100644
--- 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 ce93690..e15745b 100644
--- 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 b7a59a2..2d1d60f 100644
--- 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 2016bb1..3b0aca6 100644
--- 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 c96cb17..8267d92 100644
--- 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 2b341eb..41c95a6 100755
--- 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)" );
-- 
2.39.2