package TKL::Apache;

## $Id: Apache.pm,v 1.2 2004/01/06 14:29:34 sondberg Exp $

use Apache;
use TKL;

our @ISA = qw(Apache TKL);


## This thing overrides the generic mod_perl request method
sub request {
    my ($class, @args) = @_;
    my $apache = $class->SUPER::request(@args);
    my $tkl_file = $apache->path_info;
    my ($path) = ($tkl_file =~ /(.*)\/[^\/]*$/);
    my $self = new TKL::Apache(path => $path, apache => $apache);

    return $self;
}

## Returns a reference to the mod_perl request object
sub apache {
    return shift->{apache};
}


## Returns the document path relative to Apache's document root
sub tkl_path {
    return shift->{path};
}



## Returns portal root relative to Apache's document root
sub tkl_root {
    my $self = shift;

    return $self->{tkl_root} if defined $self->{tkl_root};
    
    my $root = $self->find_portal_root;
    my $docroot = $self->apache->document_root;

    $root =~ s/^\Q$docroot\E//;
    $root = "/$root" unless $root =~ /^\//;
    return $self->{tkl_root} = $root;
}

## Returns "current working directory" relative to portal root
sub tkl_cwd {
    my $self = shift;
    
    return $self->{tkl_cwd} if defined $self->{tkl_cwd};

    my $tklroot = $self->tkl_root;
    my $path = $self->tkl_path;

    $path =~ s/^\Q$tklroot\E//;
    $path = "/$path" unless $path =~ /^\//;
    return $self->{tkl_cwd} = $path;
}

## Returns portal relative path to requested TKL document
sub tkl_doc {
    my $self = shift;

    return $self->{tkl_doc} if defined $self->{tkl_doc};

    my $tklroot = $self->tkl_root;
    my $tkldoc = $self->apache->path_info;

    $tkldoc =~ s/^\Q$tklroot\E//;
    return $self->{tkl_doc} = $tkldoc;
}


## Override the general tkl_die method, to produce a browser friendly message
sub tkl_die {
    my ($self, @msg) = @_;
    my $apache = $self->apache;

    $apache->print("<h2>Fatal error: $0</h2>");
    foreach (@msg) {
	$apache->print("$_<br/>");
    }
    exit(1);
}
    

1;

__END__

=head1 NAME

TKL::Apache - A package of various tools for building a TKL portal in mod_perl.

=head1 SYNOPSIS

  use TKL::Apache;

  my $tkl = TKL::Apache->request();
  my $tkl_root = $tkl->tkl_root;
  my $tkl_path = $tkl->tkl_path;
  my $tkl_cwd = $tkl->tkl_cwd;

=head1 DESCRIPTION

=head1 AUTHOR

Anders Søndberberg Mortensen <sondberg@indexdata.dk>
Indexdata, Copenhagen, Denmark.
2003/07/05

=head1 SEE ALSO

Man-pages for mod_perl, Apache and the various TKL packages.