view release on metacpan or  search on metacpan

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

  $mtime = $self->last_modified(@{$self->{uri}});
  $mtime = $self->$last_modified(@{$self->{uri}}) if $self->can($last_modified);
  if ($mtime) {
    $self->{r}->update_mtime($mtime);
    $self->{r}->set_last_modified;
    $self->{status} = $self->{r}->meets_conditions;
    return $self->{status} unless $self->{status} == OK;
  }

  if ($self->can($method)) {
    #
    # process template with handler
    #
    $self->warn(1, "Can do $method: Y");

    my $cstat = $self->cache(@{$self->{uri}});
    $cstat = $self->$cache(@{$self->{uri}}) if $self->can($cache);
    if ($cstat) {
      $self->{status} = $cstat;
    } else {
      $self->{status} = $self->$method(@{$self->{uri}})
    }
    $self->{handler} =~ tr{_}{/} if $self->{expand_path} && $self->{type} =~ /^text/;
    $self->warn(1, 'Content-type: ' . $self->{type});
  } else {
    #
    # process template without handler (defaults variables only, header and footer)
    #
    $self->warn(1, "Can do $method: N");
    $self->{status} = OK unless $self->{status} == SERVER_ERROR;
  }

  return $self->{status};
}

### Additional utility methods for getting params

sub param {
  my ($self, $p) = @_;
  my @params = map { $_ = JAF::Util::trim($_); length > 0 ? $_ : undef} ($self->{r}->param($p));
  return $params[0];
} 

sub upload_fh {
  my ($self, $p) = @_;
  if($self->param($p)) {
    my $upl = $self->{r}->upload($p);
    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