From 29f3abac1a9f545358d620947a19cfd29854ce95 Mon Sep 17 00:00:00 2001 From: "Paul Buetow (pluto.buetow.org)" Date: Sat, 28 Sep 2013 22:23:51 +0200 Subject: Move Packages Configure, Parameter and Request from Xerl::Page into Xerl::Setup --- Xerl.pm | 18 +++--- Xerl/Page/Configure.pm | 158 ------------------------------------------------ Xerl/Page/Content.pm | 8 +-- Xerl/Page/Document.pm | 4 +- Xerl/Page/Menu.pm | 6 +- Xerl/Page/Parameter.pm | 50 --------------- Xerl/Page/Request.pm | 50 --------------- Xerl/Page/Rules.pm | 4 +- Xerl/Page/Templates.pm | 10 +-- Xerl/Setup/Configure.pm | 158 ++++++++++++++++++++++++++++++++++++++++++++++++ Xerl/Setup/Parameter.pm | 50 +++++++++++++++ Xerl/Setup/Request.pm | 50 +++++++++++++++ 12 files changed, 283 insertions(+), 283 deletions(-) delete mode 100644 Xerl/Page/Configure.pm delete mode 100644 Xerl/Page/Parameter.pm delete mode 100644 Xerl/Page/Request.pm create mode 100644 Xerl/Setup/Configure.pm create mode 100644 Xerl/Setup/Parameter.pm create mode 100644 Xerl/Setup/Request.pm diff --git a/Xerl.pm b/Xerl.pm index 98331e5..51375a4 100644 --- a/Xerl.pm +++ b/Xerl.pm @@ -15,30 +15,30 @@ use Time::HiRes 'gettimeofday'; use Xerl::Base; use Xerl::Main::Global; -use Xerl::Page::Configure; +use Xerl::Setup::Configure; use Xerl::Page::Document; -use Xerl::Page::Parameter; -use Xerl::Page::Request; +use Xerl::Setup::Parameter; +use Xerl::Setup::Request; use Xerl::Page::Templates; sub run($) { my Xerl $self = $_[0]; my $time = [gettimeofday]; - my Xerl::Page::Request $request = - Xerl::Page::Request->new( request => $ENV{REQUEST_URI} ); + my Xerl::Setup::Request $request = + Xerl::Setup::Request->new( request => $ENV{REQUEST_URI} ); $request->parse(); - my Xerl::Page::Configure $config = - Xerl::Page::Configure->new( config => $self->get_config(), %$request ); + my Xerl::Setup::Configure $config = + Xerl::Setup::Configure->new( config => $self->get_config(), %$request ); $config->parse(); return undef if $config->finish_request_exists(); $config->defaults(); - my Xerl::Page::Parameter $parameter = - Xerl::Page::Parameter->new( config => $config ); + my Xerl::Setup::Parameter $parameter = + Xerl::Setup::Parameter->new( config => $config ); $parameter->parse(); return undef if $config->finish_request_exists(); 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/ diff --git a/Xerl/Setup/Configure.pm b/Xerl/Setup/Configure.pm new file mode 100644 index 0000000..c4fbe18 --- /dev/null +++ b/Xerl/Setup/Configure.pm @@ -0,0 +1,158 @@ +# 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::Setup::Configure; + +use strict; +use warnings; + +use v5.14.0; + +use Xerl::Base; +use Xerl::Tools::FileIO; +use Xerl::XML::Element; + +sub parse($) { + my Xerl::Setup::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::Setup::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::Setup::Configure $self = $_[0]; + my $val = $_[1]; + + $val =~ s/^!(.+)/`$1`/eo; + + return $val; +} + +sub insertxmlvars($$) { + my Xerl::Setup::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/Setup/Parameter.pm b/Xerl/Setup/Parameter.pm new file mode 100644 index 0000000..45c860d --- /dev/null +++ b/Xerl/Setup/Parameter.pm @@ -0,0 +1,50 @@ +# 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::Setup::Parameter; + +use strict; +use warnings; + +use v5.14.0; + +use Xerl::Base; +use Xerl::Main::Global; +use Xerl::Setup::Configure; +use Xerl::Tools::FileIO; + +sub parse($) { + my Xerl::Setup::Parameter $self = $_[0]; + my Xerl::Setup::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/Setup/Request.pm b/Xerl/Setup/Request.pm new file mode 100644 index 0000000..31c18a3 --- /dev/null +++ b/Xerl/Setup/Request.pm @@ -0,0 +1,50 @@ +# 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::Setup::Request; + +use strict; +use warnings; + +use v5.14.0; + +use Xerl::Base; + +sub parse($) { + my Xerl::Setup::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; + -- cgit v1.2.3