diff options
| author | Paul Buetow (pluto.buetow.org) <paul@buetow.org> | 2013-09-28 22:23:51 +0200 |
|---|---|---|
| committer | Paul Buetow (pluto.buetow.org) <paul@buetow.org> | 2013-09-28 22:23:51 +0200 |
| commit | 29f3abac1a9f545358d620947a19cfd29854ce95 (patch) | |
| tree | 7383c6847f8150257fa8f658ad469a0009eaf5f8 /Xerl/Page | |
| parent | fd7590d71aeee380e7c87ed77de592df1f30f5ef (diff) | |
Move Packages Configure, Parameter and Request from Xerl::Page into Xerl::Setup
Diffstat (limited to 'Xerl/Page')
| -rw-r--r-- | Xerl/Page/Configure.pm | 158 | ||||
| -rw-r--r-- | Xerl/Page/Content.pm | 8 | ||||
| -rw-r--r-- | Xerl/Page/Document.pm | 4 | ||||
| -rw-r--r-- | Xerl/Page/Menu.pm | 6 | ||||
| -rw-r--r-- | Xerl/Page/Parameter.pm | 50 | ||||
| -rw-r--r-- | Xerl/Page/Request.pm | 50 | ||||
| -rw-r--r-- | Xerl/Page/Rules.pm | 4 | ||||
| -rw-r--r-- | Xerl/Page/Templates.pm | 10 |
8 files changed, 16 insertions, 274 deletions
diff --git a/Xerl/Page/Configure.pm b/Xerl/Page/Configure.pm deleted file mode 100644 index e359c52..0000000 --- a/Xerl/Page/Configure.pm +++ /dev/null @@ -1,158 +0,0 @@ -# Xerl (c) 2005-2011, 2013 Dipl.-Inform. (FH) Paul C. Buetow -# -# E-Mail: xerl@dev.buetow.org WWW: http://xerl.buetow.org -# -# This is free software, you may use it and distribute it under the same -# terms as Perl itself. - -package Xerl::Page::Configure; - -use strict; -use warnings; - -use v5.14.0; - -use Xerl::Base; -use Xerl::Tools::FileIO; -use Xerl::XML::Element; - -sub parse($) { - my Xerl::Page::Configure $self = $_[0]; - - my Xerl::Tools::FileIO $file = - Xerl::Tools::FileIO->new( 'path' => $self->get_config() ); - - if ( -1 == $file->fslurp() ) { - $self->set_finish_request(1); - return undef; - } - - my $re = qr/^(.+?) *=(.+?) *\n?$/; - - for ( @{ $file->get_array() } ) { - next if /^\s*#/; - s/#.*//; - - $self->setval( $1, $self->eval($2) ) if $_ =~ $re; - } - - return $self; -} - -sub defaults($) { - my Xerl::Page::Configure $self = $_[0]; - - $self->set_proto('https') if exists $ENV{HTTPS}; - - $self->set_site( $self->get_defaultcontent() ) - unless $self->site_exists(); - - $self->set_nsite( $self->get_site() =~ /^(?:\d*\.)?(.*)/ ); - - $self->set_template( $self->get_defaulttemplate() ) - unless $self->template_exists(); - - $self->set_style( $self->get_defaultstyle() ) - unless $self->style_exists(); - - $self->set_proto( $self->get_defaultproto() ) - unless $self->proto_exists(); - - $self->set_host( lc $ENV{HTTP_HOST} ) - unless $self->host_exists(); - - unless ( -d $self->get_hostroot() . $self->get_host() ) { - my $redirect = $self->get_hostroot() . 'redirect:' . $self->get_host(); - - if ( -f $redirect ) { - my Xerl::Tools::FileIO $file = - Xerl::Tools::FileIO->new( 'path' => $redirect ); - $file->fslurp(); - - my $location = $file->shift(); - Xerl::Main::Global::REDIRECT($location); - $self->set_finish_request(1); - } - - my $alias = $self->get_hostroot() . 'alias:' . $self->get_host(); - - if ( -f $alias ) { - my Xerl::Tools::FileIO $file = - Xerl::Tools::FileIO->new( 'path' => $alias ); - - $file->fslurp(); - $self->set_host( $file->shift() ); - } - } - - $self->set_outputformat( $self->get_defaultoutputformat() ) - unless $self->outputformat_exists(); - - if ( $self->format_exists() ) { - $self->set_outputformat( $self->get_format() ); - $self->set_template( $self->get_format() ); - $self->set_site( $self->get_format() ); - $self->set_nocache(1) - if $self->get_format() =~ /\.feed$/; - } - - $self->set_host( $self->getval( $self->get_host() ) ) - if $self->exists( $self->get_host() ); - - $self->set_host( $self->getval( $self->get_host() ) ) - if $self->exists( $self->get_host() ); - - my $request_subdir = $self->get_request_subdir(); - $self->set_hostpath( - $self->get_hostroot() . $self->get_host() . $request_subdir . "/" ); - - $self->set_defaulthostpath( - $self->get_hostroot() . $self->get_defaulthost() . '/' ); - - $self->set_cachepath( - $self->get_cacheroot() . $self->get_host() . $request_subdir . '/' ); - - $self->set_htdocspath( $self->get_hostpath() . 'htdocs/' ); - - $self->set_templatespath( $self->get_hostpath() . 'templates/' ); - - $self->set_contentpath( $self->get_hostpath() . 'content/' ); - - $self->set_is_ipv6( $ENV{REMOTE_ADDR} =~ /:/ ? 1 : 0 ); - - return undef; -} - -sub eval($$) { - my Xerl::Page::Configure $self = $_[0]; - my $val = $_[1]; - - $val =~ s/^!(.+)/`$1`/eo; - - return $val; -} - -sub insertxmlvars($$) { - my Xerl::Page::Configure $self = $_[0]; - my Xerl::XML::Element $element = $_[1]; - - $element = $element->starttag('variables'); - - return $self - unless defined $element - or $element->get_array() eq 'ARRAY'; - - my $text; - for ( @{ $element->get_array() } ) { - $text = $_->get_text(); - chomp $text; - - $text =~ s/%%(.*?)%%/$self->getval($1)/eg; - $self->setval( $_->get_name(), $text ); - } - - return $self; -} - -1; - diff --git a/Xerl/Page/Content.pm b/Xerl/Page/Content.pm index c56db72..8e4a4bf 100644 --- a/Xerl/Page/Content.pm +++ b/Xerl/Page/Content.pm @@ -18,11 +18,11 @@ use Xerl::XML::Reader; use Xerl::XML::Element; use Xerl::Page::Rules; -use Xerl::Page::Configure; +use Xerl::Setup::Configure; sub parse($) { my Xerl::Page::Content $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); my Xerl::XML::Reader $xmlcontent = Xerl::XML::Reader->new( path => $config->get_templatepath(), @@ -73,7 +73,7 @@ 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 Xerl::Setup::Configure $config = $self->get_config(); my $nonewlines = 0; # Don't interate through the XML childs if we have a leaf node. @@ -184,7 +184,7 @@ 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 Xerl::Setup::Configure $config = $self->get_config(); my $rtext = $_[3]; $$rtext =~ s/@\@text\@\@/$_=$element->get_text();chomp;$_/geo; diff --git a/Xerl/Page/Document.pm b/Xerl/Page/Document.pm index 1fba56f..a42c698 100644 --- a/Xerl/Page/Document.pm +++ b/Xerl/Page/Document.pm @@ -14,12 +14,12 @@ use v5.14.0; use Xerl::Base; use Xerl::Main::Global; -use Xerl::Page::Configure; +use Xerl::Setup::Configure; use Xerl::Tools::FileIO; sub parse($) { my Xerl::Page::Document $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); return undef unless $config->document_exists(); diff --git a/Xerl/Page/Menu.pm b/Xerl/Page/Menu.pm index 62cb58d..c702c51 100644 --- a/Xerl/Page/Menu.pm +++ b/Xerl/Page/Menu.pm @@ -12,13 +12,13 @@ use warnings; use v5.14.0; -use Xerl::Page::Configure; +use Xerl::Setup::Configure; use Xerl::Tools::FileIO; use Xerl::XML::Element; sub generate($;$) { my Xerl::Page::Menu $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); my @site = split /\//, $config->get_site(); my @compare = @site; @@ -46,7 +46,7 @@ sub generate($;$) { sub get_menu($$$$) { my Xerl::Page::Menu $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); my ( $content, $siteadd, $compare ) = ( @_[ 1 ... 2 ], lc $_[3] ); my $issubsection = $content =~ m{\.sub/$}; diff --git a/Xerl/Page/Parameter.pm b/Xerl/Page/Parameter.pm deleted file mode 100644 index 9c626b0..0000000 --- a/Xerl/Page/Parameter.pm +++ /dev/null @@ -1,50 +0,0 @@ -# Xerl (c) 2005-2011, 2013 Dipl.-Inform. (FH) Paul C. Buetow -# -# E-Mail: xerl@dev.buetow.org WWW: http://xerl.buetow.org -# -# This is free software, you may use it and distribute it under the same -# terms as Perl itself. - -package Xerl::Page::Parameter; - -use strict; -use warnings; - -use v5.14.0; - -use Xerl::Base; -use Xerl::Main::Global; -use Xerl::Page::Configure; -use Xerl::Tools::FileIO; - -sub parse($) { - my Xerl::Page::Parameter $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); - - print "Content-Type: text/plain\n\n" - if $config->plain_exists(); - - if ( $config->href_exists() ) { - print "Location: ", $config->get_href(), "\n\n"; - $config->set_finish_request(1); - } - elsif ( $config->env_exists() ) { - print "Content-Type: text/plain\n\n"; - print "$_=", $ENV{$_}, "\n" for keys %ENV; - $config->set_finish_request(1); - } - - if ( $config->devel_exists() ) { - $config->set_nocache(1); - } - - if ( $config->conf_exists() ) { - print "Content-Type: text/plain\n\n"; - print "$_=", $config->{$_}, "\n" for keys %$config; - $config->set_finish_request(1); - } - - return $self; -} - -1; diff --git a/Xerl/Page/Request.pm b/Xerl/Page/Request.pm deleted file mode 100644 index 77f893d..0000000 --- a/Xerl/Page/Request.pm +++ /dev/null @@ -1,50 +0,0 @@ -# Xerl (c) 2005-2011, 2013 Dipl.-Inform. (FH) Paul C. Buetow -# -# E-Mail: xerl@dev.buetow.org WWW: http://xerl.buetow.org -# -# This is free software, you may use it and distribute it under the same -# terms as Perl itself. - -package Xerl::Page::Request; - -use strict; -use warnings; - -use v5.14.0; - -use Xerl::Base; - -sub parse($) { - my Xerl::Page::Request $self = $_[0]; - my $request = $self->get_request(); - - # Secure it! - $request =~ s#/\.\.##g; - - # Remove last / - $request =~ s#/$##; - - my $request_subdir = $request; - $request_subdir =~ s#/\?.*##; - $self->set_request_subdir($request_subdir); - - # List context returns $1 - ($_) = $request =~ /\?(.+)/; - - return $self unless defined; - - my $params = ''; - - # List context uses ($1,$2) as method args - for ( split /&/ ) { - $self->setval(/(.+?)=(.+)/); - $params .= "&$1=$2" if $1 ne 'site'; - } - - $self->set_params($params); - - return undef; -} - -1; - diff --git a/Xerl/Page/Rules.pm b/Xerl/Page/Rules.pm index c15ba3d..cc4b2b0 100644 --- a/Xerl/Page/Rules.pm +++ b/Xerl/Page/Rules.pm @@ -14,12 +14,12 @@ use v5.14.0; use Xerl::Base; use Xerl::XML::Element; -use Xerl::Page::Configure; +use Xerl::Setup::Configure; sub parse($) { my Xerl::Page::Rules $self = $_[0]; my Xerl::XML::Element $element = $_[1]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); $element = $element->starttag2( 'rules', $config->get_outputformat() ); return unless defined $element; diff --git a/Xerl/Page/Templates.pm b/Xerl/Page/Templates.pm index 75b3807..1dd9cf7 100644 --- a/Xerl/Page/Templates.pm +++ b/Xerl/Page/Templates.pm @@ -17,7 +17,7 @@ use Digest::MD5; use Xerl::Base; -use Xerl::Page::Configure; +use Xerl::Setup::Configure; use Xerl::Page::Content; use Xerl::Page::Menu; @@ -27,7 +27,7 @@ use constant RECURSIVE => 1; sub parse($) { my Xerl::Page::Templates $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); my $site = $config->get_site(); @@ -147,7 +147,7 @@ sub parse($) { sub parsetemplate($$;$) { my Xerl::Page::Templates $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); my $deepnesslevel = $_[2] || 0; return $self if $deepnesslevel == 100; @@ -164,7 +164,7 @@ sub parsetemplate($$;$) { sub print($;$) { my Xerl::Page::Templates $self = $_[0]; - my Xerl::Page::Configure $config = $self->get_config(); + my Xerl::Setup::Configure $config = $self->get_config(); my ( $code, $flag ) = ( '', 0 ); my $time = $_[1]; @@ -210,7 +210,7 @@ sub print($;$) { # Static sub sub PARSELINE($$$;$) { - my Xerl::Page::Configure $config = $_[0]; + my Xerl::Setup::Configure $config = $_[0]; my ( $sep, $line, $foundflag ) = @_[ 1 .. 3 ]; $$line =~ s/$sep(!)?(.+?)$sep/ |
