# Xerl (c) 2005-2011,2013 Dipl.-Inform. (FH) Paul C. Buetow # # E-Mail: xerl@dev.buetow.org WWW: http://xerl.buetow.org # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # * Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # * Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # * Neither the name of buetow.org nor the names of its contributors may # be used to endorse or promote products derived from this software # without specific prior written permission. # # THIS SOFTWARE IS PROVIDED Paul C. Buetow ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT Paul C. Buetow BE LIABLE FOR ANY DIRECT, # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING # IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. package Xerl::Page::Parameter; use strict; use warnings; 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_nolog(1); $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;