view release on metacpan or  search on metacpan

lib/App/Request/CGI.pm  view on Meta::CPAN

   $request = $context->request();  # get the request

   # ... alternative way (used internally) ...
   use App::Request::CGI;
   $request = App::Request::CGI->new();

=cut

#############################################################################
# CONSTANTS
#############################################################################

=head1 DESCRIPTION

A Request class implemented using the CGI class.

=cut

#############################################################################
# PROTECTED METHODS
#############################################################################

=head1 Protected Methods:

The following methods are intended to be called by subclasses of the
current class (or environmental, "main" code).

=cut

#############################################################################
# _init()
#############################################################################

=head2 _init()

The _init() method is called from within the standard Request constructor.
The _init() method in this class does nothing.
It allows subclasses of the Request to customize the behavior of the
constructor by overriding the _init() method. 

    * Signature: $request->_init()
    * Param:     void
    * Return:    void
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    $request->_init();

=cut

sub _init {
    &App::sub_entry if ($App::trace);
    my ($self, $options) = @_;
    my ($cgi, $var, $value, $app, $file);
    $options = {} if (!defined $options);

    $app = $options->{app};
    if (!defined $app) {
        # untaint the $app
        $0 =~ /(.*)/;
        $app = $1;
        $app =~ s!\\!/!g;
        $app =~ s!\.[a-z]+$!!i;
        $app =~ s!.*/!!;
    }

    my $debug_request = $options->{debug_request} || "";
    my $replay = ($debug_request eq "replay" || $options->{replay});
    my $record = ($debug_request eq "record" && !$replay);

    #################################################################
    # read environment variables
    #################################################################

    if ($replay) {
        $file = $options->{replay_env} || "$app.env";
        if (open(App::FILE, "< $file")) {
            foreach $var (keys %ENV) {
                delete $ENV{$var};     # unset all environment variables
            }
            while (<App::FILE>) {
                chop;
                /^([^=]+)=(.*)/;       # parse variable, value (and untaint)
                $var = $1;             # get variable name
                $value = $2;           # get variable value
                $ENV{$var} = $value;   # restore environment variable
            }
            close(App::FILE);
        }
    }

    if ($record) {
       $file = "$app.env";
       if (open(App::FILE, "> $file")) {
          foreach $var (keys %ENV) {
             print App::FILE "$var=$ENV{$var}\n"; # save environment variables
          }
          close(App::FILE);
       }
    }

    #################################################################
    # READ HTTP PARAMETERS (CGI VARIABLES)
    #################################################################

    if ($replay) {
        # when the "debug_request" is in "replay", the saved CGI environment from
        # a previous query (when "debug_request" was "record") is used
        $file = $options->{replay_vars} || "$app.vars";
        open(App::FILE, "< $file") || die "Unable to open $file: $!";
        $cgi = new CGI(*App::FILE); # Get vars from debug file
        close(App::FILE);
    }
    else {  # ... the normal path
        if (defined $options && defined $options->{cgi}) {
            # this allows for migration from old scripts where they already
            # read in the CGI object and they pass it in to App-Context as an arg
            $cgi = $options->{cgi};
        }
        else {
            # this is the normal path for App-Context execution, where the Request::CGI
            # is responsible for reading its environment
            $cgi = CGI->new();
            $options->{cgi} = $cgi if (defined $options);
        }
    }

    # when the "debug_request" is "record", save the CGI vars
    if ($record) {
        $file = "$app.vars";
        if (open(App::FILE, "> $file")) {
            $cgi->save(*App::FILE);     # Save vars to debug file
            close(App::FILE);
        }
    }

    #################################################################
    # LANGUAGE
    #################################################################

    my $lang = "en_us";  # default
    if (defined $ENV{HTTP_ACCEPT_LANGUAGE}) {
        $lang = lc($ENV{HTTP_ACCEPT_LANGUAGE});