bug fix: support for working from root of virtual host

git-svn-id: file:///home/dpavlin/private/svn/webpac/trunk@302 13eb9ef6-21d5-0310-b721-a9d68796d827

diff --git a/WebPac.pm b/WebPac.pm
index 28f69ea..6484760 100644 (file)
--- a/WebPac.pm
+++ b/WebPac.pm
@@ -43,7 +43,7 @@ my $from_utf8 = Text::Iconv->new('UTF8', $CHARSET);
 sub url_ex {
        my $q = shift || die "suff2file needs CGI object!";
        my $tpl = shift || die "url_ex needs template name!";
 sub url_ex {
        my $q = shift || die "suff2file needs CGI object!";
        my $tpl = shift || die "url_ex needs template name!";

-       return suff2file($BASE_PATH, $q->url(-path => 1),$TEMPLATE_PATH,$tpl);
+       return suff2file($BASE_PATH, $q->url(-absolute => 1,-path => 1),$TEMPLATE_PATH,$tpl);

 }
 
 sub suff2file($$$$) {
 }
 
 sub suff2file($$$$) {


@@ -53,7 +53,11 @@ sub suff2file($$$$) {
 
        # strip everything to and including base path, leaving only
        # additional (virtual) path
 
        # strip everything to and including base path, leaving only
        # additional (virtual) path

-       if ($p =~ s,^.*?$base_path,,) {
+       if ($base_path eq "/") {
+               $p =~ s,/*,,g;
+               my ($name,$ext) = split(/\./,$tpl);
+               $p = $name . "-" . $p . "." . $ext;
+       } elsif ($p =~ s,^.*?$base_path,,) {

                $p =~ s,/*,,g;
                my ($name,$ext) = split(/\./,$tpl);
                $p = $name . $p . "." . $ext;
                $p =~ s,/*,,g;
                my ($name,$ext) = split(/\./,$tpl);
                $p = $name . $p . "." . $ext;


@@ -97,7 +101,7 @@ sub in_template {
                die "can't parse TEMPLATE path";
        }
 
                die "can't parse TEMPLATE path";
        }
 

-       my $master_tpl = suff2file($BASE_PATH, $q->url(-path => 1),$dir,$tpl);
+       my $master_tpl = suff2file($BASE_PATH, $q->url(-absolute => 1, -path => 1),$dir,$tpl);

        if (open(T, $master_tpl)) {
                my $template_html = join("\n",<T>);
                close(T);
        if (open(T, $master_tpl)) {
                my $template_html = join("\n",<T>);
                close(T);