I packaged Maypole for Debian some time ago and recently updated to version 2.111, the latest shown on CPAN. I realise now that the current version is 2.121, but CPAN shows that as an "unauthorized release"!
When I updated the Debian package I looked through all changes from
version 2.10, ran the test suite (repeatedly), and tested the BeerDB
example and Simon Cozens' Memories application with Apache 2, through
both CGI and mod_perl. I found multiple bugs in Maypole which I
patched; they appear still to be present in 2.121 although I haven't
tried it yet.
* Maypole::__get_mime_type matches a minimum of 3 letters after the ".";
it needs to allow 2 for ".js".
* The apache_mvc test doesn't work with mod_perl & libapr 2.
--- maypole.orig/t/apache_mvc.t
+++ maypole/t/apache_mvc.t
@@ -2,10 +2,13 @@
use strict;
use Test::More;
BEGIN {
- if (eval { require Apache::Request }) {
+ if (eval { require Apache2::RequestRec }) {
+ $ENV{MOD_PERL_API_VERSION} = 2;
+ plan tests => 3;
+ } elsif (eval { require Apache::Request }) {
plan tests => 3;
} else {
- Test::More->import(skip_all =>"Apache::Request is not installed: $@");
+ Test::More->import(skip_all =>"Neither Apache2::RequestRec nor
Apache::Request is installed: $@");
}
}
-- END --
* Maypole::view_object is replaced at run-time, resulting in a warning;
I think the initial definition can be deleted.
* The CGI handler doesn't produce any output in case of a fatal error.
--- maypole.orig/lib/CGI/Maypole.pm
+++ maypole/lib/CGI/Maypole.pm
@@ -57,7 +57,17 @@
sub run
{
my $self = shift;
- return $self->handler;
+ my $status = $self->handler;
+ if ($status != OK) {
+ print <<EOT;
+Status: 500 Maypole application error
+Content-Type: text/html
+
+<title>Maypole application error</h1>
+<h1>Maypole application error</h1>
+EOT
+ }
+ return $status;
}
=head1 Implementation
-- END --
* Maypole::Model::CDBI::_column_info can clash with
Class::DBI::mysql::_column_info. I renamed it to _init_column_info.
* The examples are somewhat inconsistent with each other and with the
tutorial.
--- maypole.orig/examples/fancy_example/BeerDB.pm
+++ maypole/examples/fancy_example/BeerDB.pm
@@ -6,11 +6,23 @@
# This is the sample application. Change this to the path to your
# database. (or use mysql or something)
use constant DBI_DRIVER => 'SQLite';
-use constant DATASOURCE => '/home/peter/Desktop/maypolebeer/beerdb';
+use constant DATASOURCE => $ENV{BEERDB_DATASOURCE} || 't/beerdb.db';
BeerDB->config->model('BeerDB::Base');
-BeerDB->setup("dbi:mysql:beerdb",'root', '');
+BEGIN {
+ my $dbi_driver = DBI_DRIVER;
+ if ($dbi_driver =~ /^SQLite/) {
+ die sprintf "SQLite datasource '%s' not found, correct the path or "
+ . "recreate the database by running Makefile.PL", DATASOURCE
+ unless -e DATASOURCE;
+ eval "require DBD::SQLite";
+ if ($@) {
+ eval "require DBD::SQLite2" and $dbi_driver = 'SQLite2';
+ }
+ }
+ BeerDB->setup(join ':', "dbi", $dbi_driver, DATASOURCE);
+}
# Give it a name.
BeerDB->config->application_name('The Beer Database');
@@ -20,7 +32,7 @@
# Change this to the htdoc root for your maypole application.
-my @root= ('/home/peter/Desktop/maypolebeer/templates');
+my @root= ('t/templates');
push @root,$ENV{BEERDB_TEMPLATE_ROOT} if ($ENV{BEERDB_TEMPLATE_ROOT});
BeerDB->config->template_root( [EMAIL PROTECTED] );
# Specify the rows per page in search results, lists, etc : 10 is a nice round
number
@@ -37,7 +49,7 @@
BeerDB::Brewery->untaint_columns( printable => [qw/name notes url/] );
BeerDB::Style->untaint_columns( printable => [qw/name notes/] );
BeerDB::Beer->untaint_columns(
- printable => [qw/abv name price notes/],
+ printable => [qw/abv name price notes url/],
integer => [qw/style brewery score/],
date =>[ qw/tasted/],
);
@@ -47,7 +59,7 @@
# Required Fields
-BeerDB->config->{brewery}{required_cols} = [qw/name url/];
+BeerDB->config->{brewery}{required_cols} = [qw/name/];
BeerDB->config->{style}{required_cols} = [qw/name/];
BeerDB->config->{beer}{required_cols} = [qw/brewery name price/];
BeerDB->config->{pub}{required_cols} = [qw/name/];
@@ -67,7 +79,7 @@
# For testing classmetadata
#sub BeerDB::Beer::classdata :Exported {};
-sub BeerDB::Beer::list_columns { return qw/score name price style brewery/};
+sub BeerDB::Beer::list_columns { return qw/score name price style brewery
url/};
sub BeerDB::Handpump::stringify_self {
my $self = shift;
--- maypole.orig/examples/fancy_example/beerdb.sql
+++ maypole/examples/fancy_example/beerdb.sql
@@ -1,27 +1,28 @@
CREATE TABLE style (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
name varchar(60),
notes text
);
CREATE TABLE pub (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
name varchar(60),
url varchar(120),
notes text
);
CREATE TABLE handpump (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
beer integer,
pub integer
);
CREATE TABLE beer (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
brewery integer,
style integer,
name varchar(30),
+ url varchar(120),
score integer(2),
price varchar(12),
abv varchar(10),
@@ -30,7 +31,7 @@
);
CREATE TABLE brewery (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
name varchar(30),
url varchar(50),
notes text
--- maypole.orig/lib/Maypole/Manual/About.pod
+++ maypole/lib/Maypole/Manual/About.pod
@@ -119,7 +119,8 @@
score integer(2),
price varchar(12),
abv varchar(10),
- notes text
+ notes text,
+ tasted date
);
create table handpump (
--- maypole.orig/examples/beerdb.sql
+++ maypole/examples/beerdb.sql
@@ -1,24 +1,24 @@
CREATE TABLE style (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
name varchar(60),
notes text
);
CREATE TABLE pub (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
name varchar(60),
url varchar(120),
notes text
);
CREATE TABLE handpump (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
beer integer,
pub integer
);
CREATE TABLE beer (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
brewery integer,
style integer,
name varchar(30),
@@ -31,7 +31,7 @@
);
CREATE TABLE brewery (
- id integer primary key auto_increment,
+ id integer not null primary key auto_increment,
name varchar(30),
url varchar(50),
notes text
-- END --
(Sadly, SQLite primary keys are allowed to be null by default.)
* There are some errors in URI construction in the factory templates.
--- maypole.orig/lib/Maypole/templates/factory/macros
+++ maypole/lib/Maypole/templates/factory/macros
@@ -14,7 +14,7 @@
[%
MACRO link(table, command, additional, label) BLOCK;
SET lnk = base _ "/" _ table _ "/" _ command _ "/" _ additional;
- lnk = lnk | uri ;
+ lnk = lnk | html ;
'<a href="' _ lnk _ '">';
label | html;
"</a>";
--- maypole.orig/lib/Maypole/templates/factory/header
+++ maypole/lib/Maypole/templates/factory/header
@@ -10,7 +10,7 @@
</title>
<meta http-equiv="Content-Type" content="text/html; charset=[%
request.document_encoding %]" />
<base href="[% config.uri_base%]"/>
- <link title="Maypole" href="[% config.uri_base %]/maypole.css"
type="text/css" rel="stylesheet" />
+ <link title="Maypole" href="[% base %]/maypole.css" type="text/css"
rel="stylesheet" />
</head>
<body>
<div class="content">
-- END --
* Maypole::Model::Base::FETCH_CODE_ATTRIBUTES uses references as hash
keys. Hash keys are just strings, not ordinary scalars, so if the
interpreter is cloned, as it will be in multithreaded configurations of
Apache, these references become invalid. The module needs to store the
references in the hash values and then rehash after cloning.
--- maypole.orig/lib/Maypole/Model/Base.pm
+++ maypole/lib/Maypole/Model/Base.pm
@@ -12,14 +12,23 @@
shift; # class name not used
my ($coderef, @attrs) = @_;
- $remember{$coderef} = [EMAIL PROTECTED];
+ $remember{$coderef} = [$coderef, [EMAIL PROTECTED];
# previous version took care to return an empty array, not sure why,
# but shall cargo cult it until know better
return;
}
-sub FETCH_CODE_ATTRIBUTES { @{ $remember{$_[1]} || [] } }
+sub FETCH_CODE_ATTRIBUTES { @{ $remember{$_[1]}->[1] || [] } }
+
+sub CLONE {
+ # re-hash %remember
+ for my $key (keys %remember) {
+ my $value = delete $remember{$key};
+ $key = $value->[0];
+ $remember{$key} = $value;
+ }
+}
sub process {
my ( $class, $r ) = @_;
-- END --
Ben.
--
Ben Hutchings
Lowery's Law:
If it jams, force it. If it breaks, it needed replacing anyway.
signature.asc
Description: This is a digitally signed message part
------------------------------------------------------------------------- This SF.net email is sponsored by: Splunk Inc. Still grepping through log files to find problems? Stop. Now Search log events and configuration files using AJAX and a browser. Download your FREE copy of Splunk now >> http://get.splunk.com/
_______________________________________________ Maypole-devel mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/maypole-devel
