- added make_path()
- added make_uri()
- improved exception handling
+ - now uses File::MMagic::XS to guess mime type of output unless already set
+ - new component method provides Maypole::Component functionality
Maypole::Model
- do_delete, do_search in place of delete/search actions
Maypole::View::TT:
lib/Maypole/Constants.pm
lib/Maypole/Headers.pm
lib/Maypole/Session.pm
+lib/Maypole/Components.pm
lib/Maypole/Manual.pod
lib/Maypole/Manual/About.pod
lib/Maypole/Manual/Install.pod
Class::DBI::Plugin::RetrieveAll: 0
Class::DBI::SQLite: 0
Digest::MD5: 0
+ HTTP::Body: 0.5
HTTP::Headers: 1.59
- HTTP::Server::Simple: 0.02
- HTTP::Server::Simple::Static: 0.01
Template: 0
Template::Plugin::Class: 0
Test::MockModule: 0
Template => 0,
Template::Plugin::Class => 0,
Test::MockModule => 0,
- Digest::MD5 => 0,
+ Digest::MD5 => 0,
+ File::MMagic::XS => 0.08,
}, # e.g., Module::Name => 1.1
(
$] >= 5.005
? ## Add these new keywords supported since 5.005
(
ABSTRACT_FROM => 'lib/Maypole.pm', # retrieve abstract from module
- AUTHOR => 'Simon flack <simonflk#cpan.org>'
+ AUTHOR => 'Aaron TEEJAY Trevena <teejay#droogs.org>'
)
: ()
),
DESCRIPTION
Maypole is a Perl framework for MVC-oriented web applications, similar
- to Jakarta's Struts. Maypole is designed to minimize coding requirements
- for creating simple web interfaces to databases, while remaining flexible
- enough to support enterprise web applications.
+ to Jakarta's Struts or Ruby on Rails. Maypole is designed to minimize
+ coding requirements for creating simple web interfaces to databases,
+ while remaining flexible enough to support enterprise web applications.
QUICK START
Maypole ships with a basic demo application, the Beer Database.
use Maypole::Config;
use Maypole::Constants;
use Maypole::Headers;
+use Maypole::Components;
use URI();
+use File::MMagic::XS qw(:compat);
our $VERSION = '2.11';
+our $mmagic = File::MMagic::XS->new();
# proposed privacy conventions:
# - no leading underscore - public to custom application code and plugins
# BeerDB::handler() and so this inherited implementation will be
# found. See e.g. "Practical mod_perl" by Bekman & Cholet for
# more information <http://modperlbook.org/html/ch25_01.html>
-sub handler : method
-{
- # See Maypole::Workflow before trying to understand this.
- my ($class, $req) = @_;
+sub handler : method {
+ # See Maypole::Workflow before trying to understand this.
+ my ($class, $req) = @_;
- $class->init unless $class->init_done;
+ $class->init unless $class->init_done;
- my $self = $class->new;
-
- # initialise the request
- $self->headers_out(Maypole::Headers->new);
- $self->get_request($req);
- $self->parse_location;
+ my $self = $class->new;
- # hook useful for declining static requests e.g. images, or perhaps for
- # sanitizing request parameters
- $self->status(Maypole::Constants::OK()); # set the default
- $self->__call_hook('start_request_hook');
- return $self->status unless $self->status == Maypole::Constants::OK();
+ # initialise the request
+ $self->headers_out(Maypole::Headers->new);
+ $self->get_request($req);
+ $self->parse_location;
- die "status undefined after start_request_hook()" unless defined
- $self->status;
+ # hook useful for declining static requests e.g. images, or perhaps for
+ # sanitizing request parameters
+ $self->status(Maypole::Constants::OK()); # set the default
+ $self->__call_hook('start_request_hook');
+ return $self->status unless $self->status == Maypole::Constants::OK();
- $self->get_session;
- $self->get_user;
+ die "status undefined after start_request_hook()" unless defined
+ $self->status;
- my $status = $self->handler_guts;
- return $status unless $status == OK;
+ $self->get_session;
+ $self->get_user;
- # TODO: require send_output to return a status code
- $self->send_output;
+ my $status = $self->handler_guts;
+ return $status unless $status == OK;
- return $status;
+ # TODO: require send_output to return a status code
+ $self->send_output;
+
+ return $status;
+}
+
+sub component {
+ my $component = Maypole::Components->new(@_);
+ return $component->handler;
}
+
# Instead of making plugin authors use the NEXT::DISTINCT hoopla to ensure other
# plugins also get to call the hook, we can cycle through the application's
# @ISA and call them all here. Doesn't work for setup() though, because it's
# less frequent path - perhaps output has been set to an error message
return OK if $self->output;
-
+
# normal path - no output has been generated yet
- return $self->__call_process_view;
+ my $processed_view_ok = $self->__call_process_view;
+
+ $self->{content_type} ||= $self->__get_mime_type();
+ $self->{document_encoding} ||= "utf-8";
+
+ return $processed_view_ok;
+}
+
+my %filetypes = (
+ 'js' => 'text/javascript',
+ 'css' => 'text/css',
+ 'htm' => 'text/html',
+ 'html' => 'text/html',
+ );
+
+sub __get_mime_type {
+ my $self = shift;
+ my $type;
+ if ($self->path =~ m/.*\.(\w{3,4})$/) {
+ $type = $filetypes{$1};
+ } else {
+ $type = $mmagic->checktype_contents($self->output);
+ }
+ return $type;
}
sub __load_request_model
return 1 if $self->model_class->is_public($action);
warn "The action '$action' is not applicable to the table '$table'"
- if $self->debug;
+ if $self->debug;
return 0;
}
--- /dev/null
+package Maypole::Components;
+use base 'Maypole';
+use strict;
+use warnings;
+use URI;
+use URI::QueryParam;
+
+sub new {
+ my ($class,$r, $path) = @_;
+ my $self = bless { config => $r->config, parent => $r }, $class;
+}
+
+sub handler {
+ my $self = shift;
+ my $url = URI->new($path);
+ $self->{path} = $url->path;
+ $self->parse_path;
+ $self->{query} = $url->query_form_hash;
+ $self->handler_guts;
+ return $self->{output};
+}
+
+sub get_template_root { shift->{parent}->get_template_root }
+sub view_object { shift->{parent}->view_object }
+
+1;
+__END__
+
+=head1 NAME
+
+Maypole::Components - Run Maypole sub-requests as components
+
+=head1 SYNOPSIS
+
+ package BeerDB;
+ use base qw(Maypole);
+
+
+
+ [% request.component("/beer/view_as_component/20") %]
+
+=head1 DESCRIPTION
+
+This subclass of Maypole allows you to integrate the results of a Maypole
+request into an existing request. You'll need to set up actions and templates
+which return fragments of HTML rather than entire pages, but once you've
+done that, you can use the C<component> method of the Maypole request object
+to call those actions. You may pass a query string in the usual URL style.
+You should not fully qualify the Maypole URLs.
+
+=head1 SEE ALSO
+
+http://maypole.perl.org/
+
+=head1 AUTHOR
+
+Simon Cozens, E<lt>simon@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004 by Simon Cozens
+
+=cut
=cut
-sub is_public
-{
- my ($self, $action) = @_;
-
- my %attrs = map {$_ => 1} $self->method_attrs($action);
-
- return 1 if $attrs{Exported};
-
- warn "'$action' not exported";
-
- return 0;
+sub is_public {
+ my ( $self, $action, $attrs ) = @_;
+ my $cv = $self->can($action);
+ warn "is_public failed . action is $action. self is $self" and return 0 unless $cv;
+
+ my %attrs = (ref $attrs) ? %$attrs : map {$_ => 1} $self->method_attrs($action,$cv) ;
+
+ do {
+ warn "is_public failed. $action not exported. attributes are : ", %attrs;
+ return 0;
+ } unless $attrs{Exported};
+ return 1;
}
+
+
=head2 method_attrs
Returns the list of attributes defined for a method. Maypole itself only
=cut
-sub method_attrs
-{
- my ($class, $method) = @_;
+sub method_attrs {
+ my ($class, $method, $cv) = @_;
- my $cv = $class->can($method);
+ $cv ||= $class->can($method);
return unless $cv;
my @attrs = attributes::get($cv);
-
+
return @attrs;
}
use Class::DBI::Pager;
use Lingua::EN::Inflect::Number qw(to_PL);
-
+use attributes ();
###############################################################################
# Helper methods
}
}
-=head2 is_public
-
-Should return true if a certain action is supported, or false otherwise.
-Defaults to checking if the sub has the C<:Exported> attribute.
-
-=cut
-
-sub is_public {
- my ( $self, $action, $attrs ) = @_;
- my $cv = $self->can($action);
- warn "is_public failed . action is $action. self is $self" and return 0 unless $cv;
- unless ($attrs) {
- my @attrs = attributes::get($cv) || ();
- $attrs = join " ", @attrs;
- }
- do {
- warn "is_public failed .$action not exported" if Maypole->debug;
- return 0;
- } unless $attrs =~ /\bExported\b/i;
- return 1;
-}
-
-
=head2 is_class
Tell if action is a class method (See Maypole::Plugin::Menu)
sub is_class {
my ( $self, $method, $attrs ) = @_;
die "Usage: method must be passed as first arg" unless $method;
- $attrs = $self->method_attrs($method) unless ($attrs);
+ $attrs = join(' ',$self->method_attrs($method)) unless ($attrs);
return 1 if $attrs =~ /\bClass\b/i;
return 1 if $method =~ /^list$/; # default class actions
return 0;
sub is_object {
my ( $self, $method, $attrs ) = @_;
die "Usage: method must be passed as first arg" unless $method;
- $attrs = $self->method_attrs($method) unless ($attrs);
+ $attrs = join(' ',$self->method_attrs($method)) unless ($attrs);
return 1 if $attrs =~ /\bObject\b/i;
return 1 if $method =~ /(^view$|^edit$|^delete$)/; # default object actions
return 0;
}
-# Get string of joined attributes for matching
-sub method_attrs {
- my ($class, $method) = @_;
- my $cv = $class->can($method);
- return 0 unless $cv;
- my @attrs = attributes::get($cv) || ();
- return join " ", @attrs;
-}
=head2 related
sub setup_database {
my ( $self, $config, $namespace, $classes ) = @_;
$config->{classes} = $classes;
- foreach my $class (@$classes) { $namespace->load_model_subclass(); }
+ 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} } ];
push(@output, File::Spec->catdir( $path, "custom" ));
push(@output, File::Spec->catdir( $path, "factory" ));
}
+
return @output;
}
sub process {
my ( $self, $r ) = @_;
- $r->{content_type} ||= "text/html";
- $r->{document_encoding} ||= "utf-8";
my $status = $self->template($r);
return $self->error($r) if $status != OK;
return OK;
projects / maypole.git / commitdiff