diff options
| author | admin (deltavega) <deltavega@mx.buetow.org> | 2018-12-22 13:37:47 +0100 |
|---|---|---|
| committer | admin (deltavega) <deltavega@mx.buetow.org> | 2018-12-22 13:37:47 +0100 |
| commit | e30f4a9430532f5dbea630a5547ba8b779542ac3 (patch) | |
| tree | 8f70a053e857f7fe7fbd275c3b984f3925f6e27a /Xerl/Setup | |
| parent | c32840d97058cf56712042309679c90da2ec1322 (diff) | |
cleanup
Diffstat (limited to 'Xerl/Setup')
| -rw-r--r-- | Xerl/Setup/Configure.pm | 169 | ||||
| -rw-r--r-- | Xerl/Setup/Parameter.pm | 50 | ||||
| -rw-r--r-- | Xerl/Setup/Request.pm | 50 |
3 files changed, 0 insertions, 269 deletions
diff --git a/Xerl/Setup/Configure.pm b/Xerl/Setup/Configure.pm deleted file mode 100644 index 406df9c..0000000 --- a/Xerl/Setup/Configure.pm +++ /dev/null @@ -1,169 +0,0 @@ -# Xerl (c) 2005-2011, 2013-2015 by Paul Buetow -# -# E-Mail: xerl@dev.buetow.org WWW: https://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 $self = $_[0]; - my $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 $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(); - - my ($hostname) = $ENV{HTTP_HOST} =~ /^([^\.]*)\./; - - $self->set_hostname( lc $hostname ) - unless $self->hostname_exists(); - - my $host = $self->get_host(); - unless ( -d $self->get_hostroot() . $host ) { - my $alias = $self->get_hostroot() . 'alias:' . $host; - my $alias_host = ''; - - unless ( -f $alias ) { - my ($hostname, @domain) = split /\./, $host; - my $domain = join '.', @domain; - $alias = $self->get_hostroot() . 'alias:' . $domain; - $alias_host = "$hostname."; - } - - if ( -f $alias ) { - my $file = Xerl::Tools::FileIO->new( 'path' => $alias ); - $file->fslurp(); - $alias_host .= $file->shift(); - - $self->set_host( $alias_host ); - } - - my $redirect = $self->get_hostroot() . 'redirect:' . $self->get_host(); - - if ( -f $redirect ) { - my $file = Xerl::Tools::FileIO->new( 'path' => $redirect ); - $file->fslurp(); - - my $location = $file->shift(); - Xerl::Main::Global::REDIRECT($location); - $self->set_finish_request(1); - } - } - - $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 $self = $_[0]; - my $val = $_[1]; - - $val =~ s/^!(.+)/`$1`/eo; - - return $val; -} - -sub insertxmlvars { - my $self = $_[0]; - my $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 deleted file mode 100644 index 8d1c019..0000000 --- a/Xerl/Setup/Parameter.pm +++ /dev/null @@ -1,50 +0,0 @@ -# Xerl (c) 2005-2011, 2013-2015 by Paul Buetow -# -# E-Mail: xerl@dev.buetow.org WWW: https://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 $self = $_[0]; - my $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 deleted file mode 100644 index e20eaa4..0000000 --- a/Xerl/Setup/Request.pm +++ /dev/null @@ -1,50 +0,0 @@ -# Xerl (c) 2005-2011, 2013-2015 by Paul Buetow -# -# E-Mail: xerl@dev.buetow.org WWW: https://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 $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; - |
