comparison Lib/IMPL/Web/QueryHandler/PageFormat.pm @ 136:f6af119ac741

url routines for templates
author wizard
date Fri, 25 Jun 2010 16:45:56 +0400
parents 44977efed303
children 6975cd4973d1
comparison
equal deleted inserted replaced
135:5b849974bed8 136:f6af119ac741
1 package IMPL::Web::QueryHandler::PageFormat; 1 package IMPL::Web::QueryHandler::PageFormat;
2 use base qw(IMPL::Web::QueryHandler IMPL::Object::Autofill); 2 use base qw(IMPL::Web::QueryHandler IMPL::Object::Autofill);
3 use strict;
3 4
4 __PACKAGE__->PassThroughArgs; 5 __PACKAGE__->PassThroughArgs;
5 6
6 use IMPL::Class::Property; 7 use IMPL::Class::Property;
7 use IMPL::Web::TT::Document; 8 use IMPL::Web::TT::Document;
9 use Template::Plugin::URL;
8 use IMPL::Security::Context; 10 use IMPL::Security::Context;
9 use File::Spec; 11 use File::Spec;
10 use Error qw(:try); 12 use Error qw(:try);
13
14 $Template::Plugin::URL::JOINT = '&';
11 15
12 BEGIN { 16 BEGIN {
13 public property templatesCharset => prop_all; 17 public property templatesCharset => prop_all;
14 public property templatesBase => prop_all; 18 public property templatesBase => prop_all;
15 public property defaultTarget => prop_all; 19 public property defaultTarget => prop_all;
32 36
33 try { 37 try {
34 38
35 $this->templatesBase($ENV{DOCUMENT_ROOT}) unless $this->templatesBase; 39 $this->templatesBase($ENV{DOCUMENT_ROOT}) unless $this->templatesBase;
36 40
37 my $pathInfo = $ENV{PATH_INFO}; 41 my ($requestUri) = split /\?/, $ENV{REQUEST_URI};
38 my $prefixRoot = ""; 42
43 my $pathInfo;
44
45 if ( $requestUri eq $ENV{SCRIPT_NAME}.$ENV{PATH_INFO} ) {
46 # CGI with path info
47 $pathInfo = $ENV{PATH_INFO};
48 } else {
49 die "REQUEST_URI: $ENV{REQUEST_URI}\nPATH_INFO: $ENV{PATH_INFO}" unless $ENV{REQUEST_URI} eq $ENV{PATH_INFO};
50 }
51
52 my @root = ('');
53 my @base;
54
39 if (my $rx = $this->pathinfoPrefix) { 55 if (my $rx = $this->pathinfoPrefix) {
40 $pathInfo =~ s/($rx)//; 56 $requestUri =~ s/^($rx)//;
41 $prefixRoot = $1 if $1; 57 push @root, grep $_, split /\//, $1 if $1;
42 } 58 }
59
60 $pathInfo = $requestUri unless defined $pathInfo;
61
62 @base = grep $_, split /\//, ($pathInfo ? substr $requestUri,0, -length($pathInfo) : $requestUri);
63
43 local $ENV{PATH_INFO} = $pathInfo || $this->defaultTarget; 64 local $ENV{PATH_INFO} = $pathInfo || $this->defaultTarget;
44 65
45 my @path = grep $_, split /\//, ($ENV{PATH_INFO} || '') or die new IMPL::Exception("PATH_INFO is empty and no defaultTarget specified" ); 66 my @path = grep $_, split /\//, ($ENV{PATH_INFO} || '') or die new IMPL::Exception("PATH_INFO is empty and no defaultTarget specified" );
46 67
47 my @pathContainer = @path; 68 my @pathContainer = @path;
48 pop @pathContainer; 69 pop @pathContainer;
49 70
50 $doc->LoadFile ( File::Spec->catfile($this->templatesBase,@path), $this->templatesCharset, $this->templatesBase ); 71 $doc->LoadFile ( File::Spec->catfile($this->templatesBase,@path), $this->templatesCharset, $this->templatesBase );
51 $doc->AddVar( result => $nextHandler->() ); 72 $doc->AddVar( result => $nextHandler->() );
52 $doc->AddVar( app => $action->application ); 73 $doc->AddVar( app => $action->application );
53 $doc->AddVar( absoluteUrl => sub { "$prefixRoot/$_[0]" } ); 74 $doc->AddVar( absoluteUrl => sub { join '/', @root, $_[0] } );
54 $doc->AddVar( relativeUrl => sub { join '/', $prefixRoot, @pathContainer,$_[0] } ); 75 $doc->AddVar( baseUrl => sub { join '/', @root, @base, $_[0] } );
76 $doc->AddVar( relativeUrl => sub { join '/', @root, @base, @pathContainer,$_[0] } );
55 { 77 {
56 local $@; 78 local $@;
57 $doc->AddVar( user => IMPL::Security::Context->current->principal ); 79 $doc->AddVar( user => IMPL::Security::Context->current->principal );
58 $doc->AddVar( session => IMPL::Security::Context->current ); 80 $doc->AddVar( session => IMPL::Security::Context->current );
59 warn $@ if $@; 81 warn $@ if $@;