use Embperl::Recipe::XSLT ;
use Embperl::Recipe::Embperl  ;
use Embperl::Recipe::EmbperlXSLT  ;
use Embperl::Recipe::EmbperlPODXSLT  ;
use Embperl::Constant ;

   
sub fill_menu 

    {
    my ($config, $item, $baseuri, $root, $parent) = @_ ;

    foreach $m (@$item)
        {
        $m -> {parent} ||= $parent ;
        $m -> {relurl}  ||= "$baseuri$m->{uri}" ;
        if (ref $m -> {path})
            {
            foreach my $k (keys %{$m -> {path}})
                { 
                if (($m -> {path}{$k} =~ /^\%(.*?)\%/))
                    {
                    if ($config -> {$1}) 
                        {
                        my $val = $config -> {$1} ;
                        $m -> {path}{$k} =~ s/^\%.*?\%/$val/ ; 
                        }
                    else
                        {
                        $m -> {path}{$k} = '' ;
                        }
                    }
                }
            }
        elsif ($m -> {path})
            {
            if (($m -> {path} =~ /^\%(.*?)\%/))
                {
                #warn "path=$m->{path}, 1=$1 c1=$config->{$1}" ;
                if ($config -> {$1}) 
                    {
                    my $val = $config -> {$1} ;
                    $m -> {path} =~ s/^\%.*?\%/$val/ ; 
                    }
                else
                    {
                    $m -> {path} = '' ;
                    }
                }
            }
        elsif (!$m -> {file} && !exists $m -> {path})
            {
            $m -> {path} = $root . $config -> {basepath} . $m -> {relurl} ;
            $m -> {path} .= 'index.htm' if ($m -> {path} =~ m#/$#) ;
            }
        elsif (ref $m -> {file})
            {
            $m -> {path} = { map { $_ => $root . $m->{file}{$_} } keys %{$m->{file}} } ;
            }
        elsif (!exists $m -> {path})
            {
            $m -> {path} = $root . $m->{file} ;
            $m -> {path} .= 'index.htm' if ($m -> {path} =~ m#/$#) ;
            }
        if ($m -> {path})
            {
            $config -> {map1}{$m -> {relurl}} = $m ;
            $config -> {map2}{$1} = $m if ($m  -> {relurl} =~ /^(.*)\./ );
            }

        my $subbase ;
        if ($m -> {relurl} !~ m#/$#)
            {
            $m -> {relurl} =~ /^(.*)\./ ;
            $subbase = "$1/" ;
            }
        else
            {
            $subbase = $m -> {relurl} ;
            }

        fill_menu ($config, $m -> {sub}, $subbase, $root, $m) if ($m -> {sub}) ;        
        fill_menu ($config, $m -> {same}, $baseuri, $root, $parent) if ($m -> {same}) ;        
        }
    }

#
# Add language to uri
#

sub languri
    {
    my ($self, $r, $uri, $lang) = @_ ;

    my $buri = $r->{config}{baseuri} ;
    $lang ||= $r -> {selected_language} ;
    $prefix = $r->{baseuri}  . ($r -> {selected_language}?'../':'') ;
    if ($lang && ($uri =~ /$buri(.*?)$/))
        {
        return "$prefix$lang/$1" ; 
        }

    return $uri ;
    }



sub map_file
    {
    my ($r, $uri) = @_ ;
    my $config = $r -> {config} ;

    # check if we have anything under this uri in our configuration
    #   if it's a directory, try to append index.*
    my $m ;
    $uri =~ /^(.*)\./ ;
    if (!($m = $config -> {map1}{$uri} || $config -> {map2}{$1}))
        {
        $m = $config -> {map1}{$1} if ($uri =~ m#^(.*?/)index\..*$#) ;
        }    

    # if we found something, setup $r -> {menuitem} to hold the menu
    # tree we need to display for this page
    if ($m && $m -> {path})
        {
        my @menuitems = ($m) ;
        my $item = $m ;
        while ($item = $item -> {parent})
            {
            unshift @menuitems, $item ;
            }
        $r -> {menuitems} = \@menuitems ;
        if ($m -> {fdat})
            {
            while (my ($k, $v) = each %{$m -> {fdat}}) 
                {
                $fdat{$k} = $v ;
                }
            }

        $r -> {curritem} = $m ;
        my $path = $m -> {path} ;
        if (ref $path)
            {
            return $path -> {$r -> param -> language} || $path -> {'en'} ;
            }

        return $path ;
        }

    # nothing found
    return ;
    }


sub init 
    {
    my $self     = shift ;
    my $r        = shift ;

    my $config = Execute ({object => 'config.pl', syntax => 'Perl'}) ;

    $config -> new ($r) ;    
    
    $r -> {config} = $config  ;    

    my $uri = $r -> param -> uri ;

    # we embed some parameters in the uri itself, to allow making a
    # static copy, so see if there is anything here
    while ($uri =~ s/\.-(.*?)-(.*?)-\././g)
        {
        $fdat{$1} = $2 ;
        }


    # figure out necessary prefixes, so we can use relativ urls
    my @uri = split (/\//, $uri) ;
    push @uri, '' if ($uri =~ m#/$#) ;
    my $basedepth = $config->{basedepth} + 1 ;
    shift @uri while ($basedepth--) ;
    my $depth = $r -> {depth} = $#uri ;

    $r -> {imageuri} = ('../' x $depth) . $config -> {imageuri} ;
    $r -> {baseuri}  = ('../' x $depth)  ;
    # this is when creating static pages, to let actions point to the correct URL of the dynamic site
    $r -> {action_prefix} = $ENV{ACTION_PREFIX} || '' ; 

    my $langs  = $config -> {supported_languages} ;
    # search the url, if there is a language embeded,
    # if yes remove it
    $r -> {selected_language} = '' ;
    my  $accept_lang = $r -> param -> language ;
    my  $lang_ok = 0 ;
    foreach (@$langs)
        {
        if ($uri[0] eq $_) 
            {
            $r -> param -> language($_) ;
            $r -> {selected_language} = $_ ;
            shift @uri ;
            $uri =~ s#/$_/#/# ;
            $r -> {baseuri}  = ('../' x ($depth - 1))  ; # we want to stay in the same language tree
            $lang_ok = 1 ;
            last ;
            }
	elsif ($accept_lang && $_ eq $accept_lang)
	    {
	    $lang_ok = 1 ;
	    }
        }

    $r -> param -> uri ($uri) ;
    $r -> param -> language($langs -> [0]) if (!$r -> param -> language || !$lang_ok) ;


    #warn "2 d = $r->{depth} bd = $config->{basedepth}  #uri=$#uri  uri = @uri new uri = $uri" ;

    # get the menu data and create a tree structure out of it if not already done
    $r -> {menu}   = $config -> get_menu ($r) ;    
    fill_menu ($config, $r -> {menu}, '', $config -> {root}) ; ##if (!$config -> {map1}) ;
   

    # map the request uri to the real filename    
    $uri = join ('/', @uri) ;
    $pf = map_file ($r, $uri) ;
    
    # try different location to statisfy links in pod via xslt 
    if (!$pf && ($uri =~ s/doc/intro/))
        {
        $pf = map_file ($r, $uri) ;
        if (!$pf && ($uri =~ s/intro/list/))
            {
            $pf = map_file ($r, $uri) ;
            if (!$pf && ($uri =~ s/list\///))
                {
                $pf = map_file ($r, $uri) ;
                }
            }
        }                            

    # nothing found, so return a general error page
    $pf = "$r->{config}{root}$r->{config}{basepath}notfound.htm" if (!$pf) ;

    $r -> param -> filename ($pf) ;      # tell Embperl the filename
    $r -> apache_req -> filename ($pf) ; # tell Apache the filename

   
    #warn Dumper ($r -> {config}, $r -> param -> uri, $pf, \%fdat, $r -> config -> path) ;
    
    # read in the multi language messages 
    Execute ({inputfile => 'messages.pl', syntax => 'Perl'}) ;

    return 0 ;
    }


sub set_xslt_param
    {
    my ($class, $r, $config, $param) = @_ ;

    $config -> xsltstylesheet('pod.xsl') ;
    my $page = $fdat{page} || 0 ;
    $r -> param -> uri =~ /^.*\/(.*)\.(.*?)$/ ;
    my $p = {
            page      => "'$page'", 
            basename  => "'$1'", 
            extension => "'$2'",
            imageuri  => "'$r->{imageuri}'",
            baseuri   => "'$r->{baseuri}'",
            language  => "'" . $r -> param -> language . "'" , 
            } ;

    $param -> xsltparam($p) ;
    }



sub get_recipe

    {
    my ($class, $r, $recipe) = @_ ;

    my $self ;
    my $param  = $r -> component -> param  ;
    my $config = $r -> component -> config  ;
    my ($src)  = $param -> inputfile =~ /^.*\.(.*?)$/ ;
    my ($dest) = $r -> param -> uri =~ /^.*\.(.*?)$/ ;

   

    if ($src)
        {
        if ($src eq 'pl')
            {
            $config -> syntax('Perl') ;
            return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
            }

        if ($src eq 'pod' || $src eq 'pm')
            {
            $config -> escmode(0) ;
            if ($dest eq 'pod')
                {
                $config -> syntax('Text') ;
                return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
                }

            $config -> syntax('POD') ;
            if ($dest eq 'xml')
                {
                return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
                }

            $class -> set_xslt_param ($r, $config, $param) ;
            return Embperl::Recipe::EmbperlXSLT -> get_recipe ($r, $recipe) ;
            }
    
        if ($src eq 'xml')
            {
            $class -> set_xslt_param ($r, $config, $param) ;
            return Embperl::Recipe::EmbperlXSLT -> get_recipe ($r, $recipe) ;
            }
    
        if ($src eq 'epd')
            {
            $config -> escmode(0) ;
            $config -> options($config -> options | &Embperl::Constant::optKeepSpaces) ;

            if ($dest eq 'pod')
                {
                $config -> syntax('EmbperlBlocks') ;
                return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
                }


            $class -> set_xslt_param ($r, $config, $param) ;
            return Embperl::Recipe::EmbperlPODXSLT -> get_recipe ($r, $recipe) ;
            }
    
        if ($src eq 'epl' || $src eq 'htm')
            {
            $config -> syntax('Embperl') ;
            return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
            }

        if ($src eq 'mail')
            {
            $config -> syntax('EmbperlBlocks') ;
            return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
            }
        }

    $config -> syntax('Text') ;
    return Embperl::Recipe::Embperl -> get_recipe ($r, $recipe) ;
    }