diff options
| author | Paul Buetow (uranus.fritz.box) <paul@buetow.org> | 2014-07-27 10:32:12 +0200 |
|---|---|---|
| committer | Paul Buetow (uranus.fritz.box) <paul@buetow.org> | 2014-07-27 10:32:12 +0200 |
| commit | 81fabce4267f8b2bbaebea9dd89c09f4df5c8477 (patch) | |
| tree | 435e4606008fb33bb91348a2498d87cfc43e5be7 /Xerl/Setup | |
| parent | ed234522bf3251c51eec23bb9dfac4ca55f857ed (diff) | |
cleanup
Diffstat (limited to 'Xerl/Setup')
| -rw-r--r-- | Xerl/Setup/Configure.pm | 163 | ||||
| -rw-r--r-- | Xerl/Setup/Parameter.pm | 50 | ||||
| -rw-r--r-- | Xerl/Setup/Request.pm | 50 |
3 files changed, 0 insertions, 263 deletions
diff --git a/Xerl/Setup/Configure.pm b/Xerl/Setup/Configure.pm deleted file mode 100644 index 18c49fe..0000000 --- a/Xerl/Setup/Configure.pm +++ /dev/null @@ -1,163 +0,0 @@ -# Xerl (c) 2005-2011, 2013, 2014 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(); - - my ($hostname) = $ENV{HTTP_HOST} =~ /^([^\.]*)\./; - - $self->set_hostname( lc $hostname ) - unless $self->hostname_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 deleted file mode 100644 index 45c860d..0000000 --- a/Xerl/Setup/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::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 deleted file mode 100644 index 31c18a3..0000000 --- a/Xerl/Setup/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::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; - |
