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

lib/Apache/JAF.pm  view on Meta::CPAN

    return $upl->fh if($upl && $upl->fh)
  }
  return undef
}

### Methods for simplify handlers for download content instead of viewing it

sub disable_header { undef $_[0]->{header} }
sub disable_footer { undef $_[0]->{footer} }
sub disable_header_footer { $_[0]->disable_header(); $_[0]->disable_footer(); }
sub download_type { $_[0]->{type} = 'application/x-force-download'; }
sub download_it { $_[0]->disable_header_footer(); $_[0]->download_type(); }

### methods for JAF database editing

sub default_record_edit {
  my ($self, $tbl, $options) = @_;

  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';