Apache-JAF
view release on metacpan or search on metacpan
lib/Apache/JAF.pm view on Meta::CPAN
package Apache::JAF;
use 5.6.0;
use strict;
use Template ();
use Template::Provider;
use Template::Parser;
use Template::Document;
our @ISA = qw( Template::Provider );
use Apache ();
use Apache::Util ();
use Apache::JAF::Util ();
use JAF::Util ();
use Apache::Request ();
use Apache::Constants qw( :common REDIRECT );
use Apache::File ();
use Data::Dumper qw( Dumper );
use File::Find ();
our $WIN32 = $^O =~ /win32/i;
our $RX = $WIN32 ? qr/\:(?!(?:\/|\\))/ : qr/\:/;
our $VERSION = do { my @r = (q$Revision: 0.21 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
# Constructor
################################################################################
sub new {
my ($ref, $r) = @_;
my $self = {};
#
# use as template provider
#
if (ref($r) eq 'HASH') {
$self = $ref->SUPER::new($r);
bless ($self, $ref);
return $self;
}
#
# use as framework
#
$r = Apache::Request->instance($r);
bless ($self, $ref);
# r - request (filter-aware)
$self->{filter} = lc $r->dir_config('Filter') eq 'on';
$self->{r} = $self->{filter} ? $r->filter_register() : $r;
my $prefix = $r->dir_config('Apache_JAF_Prefix') || 0;
# prefix - path|number of subdirs that must be removed from uri
$prefix = ($prefix =~ /^\/(.*)$/) ? scalar(my @tmp = split '/', $1) : int($prefix);
# uri - reference to array that contains uri plitted by '/'
my @uri = split '/', $self->{r}->uri;
shift @uri if $prefix;
splice @uri, 0, ($prefix || 1);
if (@uri) {
$uri[-1] =~ s/\.html?$//i;
my $i = 0;
while ($i < @uri) {
splice @uri, $i, 2 if $uri[$i] =~ /^\w+:$/ && !$uri[$i+1];
$i++;
}
}
$self->{uri} = \@uri;
# res - result hash, that passed to the template
$self->{res} = {};
# for complex-name-handlers change '_' in handler name to '/' to provide
# real document tree in Templates folder
$self->{expand_path} = 1;
# Level of warnings that will be written to the server's error_log
# every next level includes all options from previous
# 0: critical errors only
# 1: request processing line
# 2: client request
# 3: response headers
# 4: template variables
# 9: loading additional handlers
# 10: processed template
$self->{debug_level} = $self->{r}->dir_config('Apache_JAF_Debug') || 0;
# Default response status and content-type
$self->{status} = NOT_FOUND;
$self->{type} = 'text/html';
# Default template and includes extensions
$self->{template_ext} = '.html';
$self->{include_ext} = '.inc';
$self->{default_include} = 'default';
# pre- and post-process templates (without extensions)
$self->{header} = 'header';
$self->{footer} = 'footer';
$self->{pre_chomp} = $self->{post_chomp} = $self->{trim} = 1;
# Templates folder
$self->{templates} = $self->{r}->dir_config('Apache_JAF_Templates');
lib/Apache/JAF.pm view on Meta::CPAN
if ($self->{r}->method() eq 'POST' && $self->param('act') eq 'edit') {
$tbl->update({
$tbl->{key} => $self->param($tbl->{key}),
map {defined $self->{r}->param($_) ? ($_ => $self->param($_)) : $options->{checkbox} && exists $options->{checkbox}{$_} ? ($_ => $options->{checkbox}{$_}) : ()} @{$tbl->{cols}}
}, $options);
}
}
sub default_table_edit {
my ($self, $tbl, $options) = @_;
if ($self->{r}->method() eq 'POST' && $self->param('act') eq 'edit') {
for (my $i=1; defined $self->param("$tbl->{key}_$i"); $i++) {
$tbl->delete({
$tbl->{key} => $self->param("$tbl->{key}_$i")
}, $options) if $self->param("dowhat_$i") eq 'del';
$tbl->update({
$tbl->{key} => $self->param("$tbl->{key}_$i"),
map {defined $self->{r}->param("${_}_$i") ? ($_ => $self->param("${_}_$i")) : $options->{checkbox} && exists $options->{checkbox}{$_} ? ($_ => $options->{checkbox}{$_}) : ()} @{$tbl->{cols}}
}, $options) if $self->param("dowhat_$i") eq 'upd';
}
} elsif ($self->param('act') eq 'add') {
unless ($tbl->insert({
map {defined $self->{r}->param($_) ? ($_ => $self->param($_)) : $options->{checkbox} && exists $options->{checkbox}{$_} ? ($_ => $options->{checkbox}{$_}) : ()} @{$tbl->{cols}}
}, $options)) {
foreach (@{$tbl->{cols}}) {
$self->{res}{$_} = $self->param($_);
}
}
}
}
sub default_messages {
my ($self, $modeller) = @_;
%{$self->{cookies}} = Apache::Cookie->fetch() unless $self->{cookies};
if ($self->{status} == REDIRECT) {
my $messages = $modeller->messages();
if ($messages) {
Apache::Cookie->new($self->{r},
-name => 'messages',
-path => '/',
-value => Data::Dumper::Dumper $messages)->bake();
}
} elsif ($self->{status} == OK && $self->{type} =~ /^text/ && !$self->{r}->header_only) {
my $VAR1;
if (exists $self->{cookies}{messages} && eval $self->{cookies}{messages}->value) {
$self->{res}{messages} = $VAR1;
Apache::Cookie->new($self->{r},
-name => $self->{res}{messages} ? 'messages' : 'error',
-path => '/',
-value => '')->bake();
} else {
$self->{res}{messages} = $modeller->messages();
}
}
}
=head1 NAME
Apache::JAF -- mod_perl and Template-Toolkit web applications framework
=head1 SYNOPSIS
=over 4
=item controller -- a mod_perl module that drives your application
package Apache::JAF::MyJAF;
use strict;
use JAF::MyJAF; # optional
# loading mini-handlers & templates during compilation time
use Apache::JAF (
handlers => '/examples/site/modules/Apache/JAF/MyJAF/pages/', # 'auto' if you want to use suggested file structure
templates => '/examples/site/templates/' # the same comment
);
our @ISA = qw(Apache::JAF);
# determine handler to call
sub setup_handler {
my ($self) = @_;
# the page handler for each URI of sample site is 'do_index'
# you should swap left and right ||-parts for real application
my $handler = 'index' || shift @{$self->{uri}};
return $handler;
}
sub site_handler {
my ($self) = @_;
# common stuff before handler is called
$self->{m} = JAF::MyJAF->new(); # create modeller -- if needed
$self->SUPER::site_handler();
# common stuff after handler is called
return $self->{status}
}
1;
=item page handler -- controller's method that makes one (or more) pages
sub do_index {
my ($self) = @_;
# page handler must fill $self->{res} hash that process with template
$self->{res}{test} = __PACKAGE__ . 'test';
# and return Apache constant according it's logic
return OK;
}
=item modeller -- a module that encapsulates application business-logic
package JAF::MyJAF;
use strict;
use DBI;
use base qw( JAF );
sub new {
my ($class, $self) = @_;
$self->{dbh} = DBI->connect(...);
return bless $self, $class;
}
1;
( run in 1.579 second using v1.01-cache-2.11-cpan-df04353d9ac )