view release on metacpan or  search on metacpan

lib/Apache2/DirBasedHandler.pm  view on Meta::CPAN

    my $r = Apache2::Request->new(shift);

    my $uri_bits = $self->parse_uri($r);
    my $args = $self->init($r);

    my $function;
    my $uri_args = [];
    if (@{$uri_bits}) {
        while (@{$uri_bits}) {
            my $try_function = $self->uri_to_function($r,$uri_bits);
            
            $debug && $r->warn(qq[trying $try_function]);
            if ($self->can($try_function)) {
                $debug && $r->warn(qq[$try_function works!]);
                $function = $try_function;
                last;
            }
            else {
                $debug && $r->warn(qq[$try_function not found]);
                unshift @{$uri_args}, pop @{$uri_bits};
            }
        }
        $function ||= q[root_index];
    }
    else {
        $function = q[root_index];
    }
   
    if (!$function) {
        $debug && $r->warn(q[i do not know what to do with ]. $r->uri);
        return Apache2::Const::NOT_FOUND;
    }
    
    $debug && $r->warn(qq[calling $function with path_args (] . join(q[,],@{$uri_args}).q[)]);
    my ($status,$page_out,$content_type) =
        $self->$function($r,$uri_args,$args);

    if ($status ne Apache2::Const::OK) {
        return $status;
    }

    $r->content_type($content_type);
    $r->print($page_out);
    return $status;
}

sub init {
    my ($self,$r) = @_;
    return {};
}

sub parse_uri {
    my ($self,$r) = @_;

    my $loc = $r->location;
    my $uri = $r->uri;
    # replace multiple slashes with single slashes
    $uri =~ s/\/+/\//gixm;
    # strip the location off the start of the uri
    $uri =~ s/^$loc\/?//xm;
    my @split_uri = split m{/}xm, $uri;

    return \@split_uri;
}

sub uri_to_function {
    my ($self,$r,$uri_bits) = @_;

    return join('_', @{$uri_bits}) . q[_page];
}

sub root_index {
    return (
        Apache2::Const::OK,
        q[you might want to override "root_index"],
        'text/html; charset=utf-8'
    );
}

sub set_debug {
    $debug = shift;
    return;
}

1;

__END__

=head1 NAME

Apache2::DirBasedHandler - Directory based Location Handler helper

=head1 VERSION

This documentation refers to <Apache2::DirBasedHandler> version 0.03

=head1 SYNOPSIS

  package My::Thingy

  use strict
  use Apache2::DirBasedHandler
  our @ISA = qw(Apache2::DirBasedHandler);
  use Apache2::Const -compile => qw(:common);

  sub root_index {
      my $self = shift;
      my ($r,$uri_args,$args) = @_;

      if (@$uri_args) {
          return Apache2::Const::NOT_FOUND;
      }

      return (
          Apache2::Const::OK,
          qq[this is the index],
          qq[text/plain; charset=utf-8]
      );
  }

  sub super_page {