summaryrefslogtreecommitdiff
path: root/Xerl/Page/Content.pm
diff options
context:
space:
mode:
authorPaul Buetow (pluto.buetow.org) <paul@buetow.org>2013-09-15 11:51:10 +0200
committerPaul Buetow (pluto.buetow.org) <paul@buetow.org>2013-09-15 11:51:10 +0200
commit6aa12ae5f556ab884b7705379c41a566df86d028 (patch)
tree85441b3a046f58970ebe9ad55460c16e4f4d3d01 /Xerl/Page/Content.pm
parentc183faa4d53b6e4f091d6b38397847e55b5d2251 (diff)
temp remove includedirs tag, perltidy indention set to 2, initial XML::LibXML
Diffstat (limited to 'Xerl/Page/Content.pm')
-rw-r--r--Xerl/Page/Content.pm280
1 files changed, 139 insertions, 141 deletions
diff --git a/Xerl/Page/Content.pm b/Xerl/Page/Content.pm
index da70139..bd3e8ee 100644
--- a/Xerl/Page/Content.pm
+++ b/Xerl/Page/Content.pm
@@ -40,190 +40,188 @@ 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::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
- );
+ 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;
- }
+ if ( -1 == $xmlcontent->open() ) {
+ $config->set_finish_request(1);
+ return undef;
+ }
- $xmlcontent->parse();
+ $xmlcontent->parse();
- my Xerl::Page::Rules $rules = Xerl::Page::Rules->new( config => $config );
- $rules->parse( $config->get_xmlconfigrootobj() )
- unless $config->exists('noparse');
+ 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() );
+ $config->insertxmlvars( $config->get_xmlconfigrootobj() );
+ $self->insertrules( $rules, $xmlcontent->get_root() );
- return undef;
+ 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::Content $self = $_[0];
+ my Xerl::Page::Rules $rules = $_[1];
+ my Xerl::XML::Element $element = $_[2];
- # Start inserting rules at <content>
- $element = $element->starttag('content');
+ # Start inserting rules at <content>
+ $element = $element->starttag('content');
- # If there is no <content>-tag, dont use a rule!
- return unless defined $element;
+ # If there is no <content>-tag, dont use a rule!
+ return unless defined $element;
- my @content;
- my $params = $element->get_params();
+ my @content;
+ my $params = $element->get_params();
- unshift @content, "Content-Type: $params->{type}\n\n"
- if ref $params eq 'HASH' and exists $params->{type};
+ 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 );
+ push @content, $self->_insertrules( $rules, $element );
+ $self->set_content( \@content );
- return undef;
+ 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' ) {
+ 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";
- }
- }
+ 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 {
- # 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.
+ }
+ else {
- my $ruleparams = $rule->[2];
- $nonewlines = 1 if exists $ruleparams->{nonewlines};
+ # No rule available, use the tag unmodified!
+ $name =~ s/^=//o; # Remove the leading =
+ if ( $succ->get_single() ) {
+ push @content, "<$name" . ( $succ->params_str() || '' ) . " />\n"
- my ( $orule, $crule ) = ( $rule->[0], $rule->[1] );
+ }
+ else {
+ push @content,
+ "<$name" . ( $succ->params_str() || '' ) . '>',
+ $self->_insertrules( $rules, $succ ), $text, "</$name>\n";
+ }
+ }
- $self->_insert_special_vars( $rules, $succ, \$orule );
- $self->_insert_special_vars( $rules, $succ, \$crule );
- chomp $orule;
+ }
+ else {
- # Parse for known tag params.
- if ( ref $params eq 'HASH' ) {
- Xerl::Page::Templates::PARSELINE( $config, '%%', \$text );
+ # 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.
- # <tag basename='yes'>path/to/file.bla</tag> => <tag>file.bla</tag>
- $text =~ s#.*/(.*)$#$1# if lc $params->{basename} eq 'yes';
+ my $ruleparams = $rule->[2];
+ $nonewlines = 1 if exists $ruleparams->{nonewlines};
- # <tag cut='?'>foo.bar.tld?options</tag> => <tag>?options</tag>
- if ( exists $params->{cut} ) {
- my $cut = quotemeta $params->{cut};
- $text =~ s/.*$cut(.*)$/$1/o;
- }
+ my ( $orule, $crule ) = ( $rule->[0], $rule->[1] );
- $text .= $params->{addback}
- if exists $params->{addback};
- $text = $params->{addfront} . $text
- if exists $params->{addfront};
- }
+ $self->_insert_special_vars( $rules, $succ, \$orule );
+ $self->_insert_special_vars( $rules, $succ, \$crule );
+ chomp $orule;
- my $oadd =
- exists $ruleparams->{addfront}
- ? '<' . $ruleparams->{addfront}
- : '';
+ # Parse for known tag params.
+ if ( ref $params eq 'HASH' ) {
+ Xerl::Page::Templates::PARSELINE( $config, '%%', \$text );
- my $cadd =
- exists $ruleparams->{addback} ? $ruleparams->{addback} . '>' : '';
+ # <tag basename='yes'>path/to/file.bla</tag> => <tag>file.bla</tag>
+ $text =~ s#.*/(.*)$#$1# if lc $params->{basename} eq 'yes';
- push @content, $orule, $oadd, $self->_insertrules( $rules, $succ ),
- $text, $cadd, $crule;
+ # <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;
+ 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];
+ 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/@\@text\@\@/$_=$element->get_text();chomp;$_/geo;
+ $$rtext =~ s/@\@ln\@\@//go;
- #$$rtext =~ s/@\@link\@\@/$element->get_params()->{link}.'$$params$$'/geo;
+ #$$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;
- }
+ if ( $$rtext =~ /@\@(.*?)\@\@/ ) {
+ my $params = $element->get_params();
+ return unless ref $params eq 'HASH';
+ $$rtext =~ s/@\@(.*?)\@\@/$params->{$1}||''/geo;
+ }
- return undef;
+ return undef;
}
1;