# Xerl (c) 2005-2011, Dipl.-Inform. (FH) Paul C. Buetow
#
# 	E-Mail: xerl@dev.buetow.org 	WWW: http://xerl.buetow.org
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * Neither the name of buetow.org nor the names of its contributors may
# 	  be used to endorse or promote products derived from this software
# 	  without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED Paul C. Buetow ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT Paul C. Buetow BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
#  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
# IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

package Xerl::Page::Content;

use strict;
use warnings;

use Xerl::Base;

use Xerl::XML::Reader;
use Xerl::XML::Element;
use Xerl::Page::Rules;
use Xerl::Page::Configure;

sub parse($) {
    my Xerl::Page::Content $self     = $_[0];
    my Xerl::Page::Configure $config = $self->get_config();

    my Xerl::XML::Reader $xmlcontent = Xerl::XML::Reader->new(
        path   => $config->get_templatepath(),
        config => $config
    );

    if ( -1 == $xmlcontent->open() ) {
        $config->set_finish_request(1);
        return undef;
    }

    $xmlcontent->parse();

    my Xerl::Page::Rules $rules = Xerl::Page::Rules->new( config => $config );
    $rules->parse( $config->get_xmlconfigrootobj() )
      unless $config->exists('noparse');

    $config->insertxmlvars( $config->get_xmlconfigrootobj() );
    $self->insertrules( $rules, $xmlcontent->get_root() );

    return undef;
}

sub insertrules($$$$) {
    my Xerl::Page::Content $self   = $_[0];
    my Xerl::Page::Rules $rules    = $_[1];
    my Xerl::XML::Element $element = $_[2];

    # Start inserting rules at <content>
    $element = $element->starttag('content');

    # If there is no <content>-tag, dont use a rule!
    return unless defined $element;

    my @content;
    my $params = $element->get_params();

    unshift @content, "Content-Type: $params->{type}\n\n"
      if ref $params eq 'HASH' and exists $params->{type};

    push @content, $self->_insertrules( $rules, $element );
    $self->set_content( \@content );

    return undef;
}

sub _insertrules($$$) {
    my Xerl::Page::Content $self     = $_[0];
    my Xerl::Page::Rules $rules      = $_[1];
    my Xerl::XML::Element $element   = $_[2];
    my Xerl::Page::Configure $config = $self->get_config();
    my $nonewlines                   = 0;

    #$element->print();
    #
    # Don't interate through the XML childs if we have a leaf node.
    return () unless ref $element->get_array() eq 'ARRAY';
    my ( $name, $rule, @content, $text, $params );

    for my $succ ( @{ $element->get_array() } ) {
        $name   = $succ->get_name();
        $text   = $succ->get_text();
        $params = $succ->get_params();

        # Remove leading and ending whitespaces, also ending newlines.
        $text =~ s/^ *(.*)( |\n)*$/$1/g;
        unless ( ref( $rule = $rules->getval($name) ) eq 'ARRAY' ) {
            if ( lc $name eq 'noop' ) {
                if ( ref $succ->get_array() eq 'ARRAY' ) {
                    push @content, $self->_insertrules( $rules, $succ );

                }
                else {
                    push @content, "$text\n";
                }

            }
            elsif ( lc $name eq 'tag' ) {
                push @content, "<$text>\n";

            }
            elsif ( lc $name eq 'perl' ) {

        # Perl content will be interpreted by Xerl::Page::Templates::print later
                push @content, '<perl>', $text, '</perl>';

            }
            elsif ( lc $name eq 'navigation' ) {
                my $menus = $config->get_menuobj()->get_array();

                if ( ref $menus eq 'ARRAY' ) {
                    push @content, $self->_insertrules( $rules, $_ )
                      for @$menus;
                }

            }
            else {

                # No rule available, use the tag unmodified!
                $name =~ s/^=//o;    # Remove the leading =
                if ( $succ->get_single() ) {
                    push @content,
                      "<$name" . ( $succ->params_str() || '' ) . " />\n"

                }
                else {
                    push @content,
                      "<$name" . ( $succ->params_str() || '' ) . '>',
                      $self->_insertrules( $rules, $succ ), $text, "</$name>\n";
                }
            }

        }
        else {

            # Get a local copy of lrule, because orule may be modified.
            # And then insert special vars if required:
            #  @@text@@ => Text content of the current tag.

            my $ruleparams = $rule->[2];
            $nonewlines = 1 if exists $ruleparams->{nonewlines};

            my ( $orule, $crule ) = ( $rule->[0], $rule->[1] );

            $self->_insert_special_vars( $rules, $succ, \$orule );
            $self->_insert_special_vars( $rules, $succ, \$crule );
            chomp $orule;

            # Parse for known tag params.
            if ( ref $params eq 'HASH' ) {
                Xerl::Page::Templates::PARSELINE( $config, '%%', \$text );

             # <tag basename='yes'>path/to/file.bla</tag> => <tag>file.bla</tag>
                $text =~ s#.*/(.*)$#$1# if lc $params->{basename} eq 'yes';

                # <tag cut='?'>foo.bar.tld?options</tag> => <tag>?options</tag>
                if ( exists $params->{cut} ) {
                    my $cut = quotemeta $params->{cut};
                    $text =~ s/.*$cut(.*)$/$1/o;
                }

                $text .= $params->{addback}
                  if exists $params->{addback};
                $text = $params->{addfront} . $text
                  if exists $params->{addfront};
            }

            my $oadd =
              exists $ruleparams->{addfront}
              ? '<' . $ruleparams->{addfront}
              : '';

            my $cadd =
              exists $ruleparams->{addback} ? $ruleparams->{addback} . '>' : '';

            push @content, $orule, $oadd, $self->_insertrules( $rules, $succ ),
              $text, $cadd, $crule;
        }
    }

    return $nonewlines ? map { s/\n/ /go; $_ } @content : @content;
}

sub _insert_special_vars($$$$) {
    my Xerl::Page::Content $self     = $_[0];
    my Xerl::Page::Rules $rules      = $_[1];
    my Xerl::XML::Element $element   = $_[2];
    my Xerl::Page::Configure $config = $self->get_config();
    my $rtext                        = $_[3];

    $$rtext =~ s/@\@text\@\@/$_=$element->get_text();chomp;$_/geo;
    $$rtext =~ s/@\@ln\@\@//go;

    #$$rtext =~ s/@\@link\@\@/$element->get_params()->{link}.'$$params$$'/geo;

    if ( $$rtext =~ /@\@(.*?)\@\@/ ) {
        my $params = $element->get_params();
        return unless ref $params eq 'HASH';
        $$rtext =~ s/@\@(.*?)\@\@/$params->{$1}||''/geo;
    }

    return undef;
}

1;