package OpenInteract2::Request;

# $Id: Request.pm,v 1.42 2004/04/28 01:26:00 lachoy Exp $

use strict;
use base qw( Class::Factory Class::Accessor::Fast );
use Log::Log4perl            qw( get_logger );
use DateTime;
use DateTime::Format::Strptime;
use OpenInteract2::Constants qw( :log SESSION_COOKIE );
use OpenInteract2::Context   qw( CTX );
use OpenInteract2::Cookie;
use OpenInteract2::Exception qw( oi_error );
use OpenInteract2::I18N;
use OpenInteract2::SessionManager;
use OpenInteract2::URL;

$OpenInteract2::Request::VERSION = sprintf("%d.%02d", q$Revision: 1.42 $ =~ /(\d+)\.(\d+)/);

my ( $log );

########################################
# ACCESSORS

my @FIELDS = qw(
    server_name remote_host
    user_agent referer cookie_header language_header
    url_absolute url_relative url_initial action_name task_name
    session auth_user auth_group auth_is_admin auth_is_logged_in
);
__PACKAGE__->mk_accessors( @FIELDS );

my ( $REQUEST_TYPE, $REQUEST_CLASS );

sub set_implementation_type {
    my ( $class, $type ) = @_;
    my $impl_class = eval { $class->get_factory_class( $type ) };
    oi_error $@ if ( $@ );
    $REQUEST_TYPE  = $type;
    $REQUEST_CLASS = $impl_class;
    return $impl_class;
}

sub get_implementation_type {
    return $REQUEST_TYPE;
}

# Retrieve the current object

sub get_current {
    if ( $REQUEST_CLASS ) {
        return $REQUEST_CLASS->get_current;
    }
    else {
        oi_error "No request class defined -- run 'set_implementation_type()' ",
                 "to set the type of requests we'll be processing.";
    }
}


sub new {
    my ( $class, @params ) = @_;
    $log ||= get_logger( LOG_REQUEST );
    unless ( $REQUEST_CLASS ) {
        $log->fatal( "No request implementation type set" );
        oi_error 'Before creating an OpenInteract2::Request object you ',
                 'must set the request type with "set_implementation_type()"';
    }
    my $self = bless( { '_upload' => {},
                        '_param'  => {},
                        '_cookie' => {} }, $REQUEST_CLASS );

    $self->init( @params );

    # Now that all the cookie/session/language data has been set by
    # request impl, call the code that uses that to set other
    # properties...

    $self->_parse_cookies;
    $self->_create_session;

    CTX->request( $self );
    return $self;
}


########################################
# PARAMETERS

sub param {
    my ( $self, $name, $value ) = @_;
    unless ( $name ) {
        return keys %{ $self->{_param} };
    }
    if ( defined $value ) {
        $self->{_param}{ $name } = $value;
    }
    if ( ref $self->{_param}{ $name } eq 'ARRAY' ) {
        return ( wantarray )
                 ? @{ $self->{_param}{ $name } }
                 : $self->{_param}{ $name };
    }
    if ( exists $self->{_param}{ $name } ) {
        return ( wantarray )
                 ? ( $self->{_param}{ $name } )
                 : $self->{_param}{ $name };
    }
    return wantarray ? () : undef;
}


sub param_toggled {
    my ( $self, $name ) = @_;
    return ( defined $self->param( $name ) ) ? 'yes' : 'no';

}

sub param_date {
    my ( $self, $name, $format ) = @_;
    if ( $format ) {
        return $self->_parse_date_with_format( $name, $format );
    }
    my ( $y, $m, $d ) = ( $self->param( $name . '_year' ),
                          $self->param( $name . '_month' ),
                          $self->param( $name . '_day' ) );
    return undef unless ( $y and $m and $d );
    return DateTime->new( year  => $y,
                          month => $m,
                          day   => $d );
}

sub param_datetime {
    my ( $self, $name, $format ) = @_;
    if ( $format ) {
        return $self->_parse_date_with_format( $name, $format );
    }
    my $date = $self->param_date( $name );
    return undef unless ( defined $date );
    my ( $hour, $minute, $am_pm ) =
        ( $self->param( $name . '_hour' ),
          $self->param( $name . '_minute' ),
          $self->param( $name . '_am_pm' ) );
    if ( lc $am_pm eq 'pm' and $hour < 12 ) {
        $hour += 12;
    }
    $date->set( hour   => $hour,
                minute => $minute );
    return $date;
}

sub _parse_date_with_format {
    my ( $self, $name, $format ) = @_;
    my $date_value = $self->param( $name );
    unless ( $date_value ) {
        return undef;
    }
    my $parser = DateTime::Format::Strptime->new( pattern  => $format,
                                                  on_error => 'croak' );
    my $dt = eval { $parser->parse_datetime( $date_value ) };
    if ( $@ ) {
        oi_error "Failed to parse date '$date_value' with format '$format': $@";
    }
    return $dt;
}


########################################
# PROPERTIES

# shortcut
sub auth_user_id {
    my ( $self ) = @_;
    return ( $self->auth_is_logged_in ) ? $self->auth_user->id : 0;
}


sub assign_request_url {
    my ( $self, $full_url_path ) = @_;
    $log ||= get_logger( LOG_REQUEST );
    $log->is_info &&
        $log->info( "Setting absolute URL '$full_url_path'" );
    $self->url_absolute( $full_url_path );
    my $relative_url =
        OpenInteract2::URL->parse_absolute_to_relative( $full_url_path );
    $log->is_debug &&
        $log->debug( "Setting relative URL '$relative_url'" );
    $self->url_relative( $relative_url );

    my ( $action_url, $task ) = OpenInteract2::URL->parse( $relative_url );
    $self->url_initial( $action_url );
    my ( $action_name );
    if ( $action_url ) {
        $action_name = eval { CTX->lookup_action_name( $action_url ) };
        if ( $@ ) {
            my $action_nf = CTX->lookup_action_not_found();
            $action_name = $action_nf->name;
        }
    }
    else {
        my $action_none = CTX->lookup_action_none();
        $action_name = $action_none->name;
    }
    $action_name ||= '';
    $task        ||= '';
    $self->action_name( $action_name );
    $self->task_name( $task );
    $log->is_info &&
        $log->info( "Pulled action info '$action_name: $task' from URL" );
    return $relative_url;
}

sub action_messages {
    my ( $self, $name, $messages ) = @_;
    return {} unless ( $name );

    if ( ref $messages eq 'HASH' ) {
        $self->{_action_msg}{ lc $name } = $messages;
    }
    return $self->{_action_msg}{ lc $name };
}

sub add_action_message {
    my ( $self, $action_name, $error_name, $error ) = @_;
    return $self->{_action_msg}{ lc $action_name }{ $error_name } = $error;
}

sub auth_clear {
    my ( $self ) = @_;
    for ( qw( auth_user auth_group auth_is_admin auth_is_logged_in ) ) {
        $self->{ $_ } = undef;
    }
}

########################################
# UPLOADS

sub upload {
    my ( $self, $name ) = @_;
    if ( $name ) {
        if ( ! $self->{_upload}{ $name } ) {
            return wantarray ? () : undef;
        }
        elsif ( ref $self->{_upload}{ $name } eq 'ARRAY' and wantarray ) {
            return @{ $self->{_upload}{ $name } };
        }
        return wantarray ? ( $self->{_upload}{ $name } )
                         : $self->{_upload}{ $name };
    }
    $self->{_upload} ||= {};
    my @items = ();
    foreach my $item ( values %{ $self->{_upload} } ) {
        next unless ( $item );
        if ( ref $item eq 'ARRAY' ) {
            push @items, @{ $item };
        }
        else {
            push @items, $item;
        }
    }
    return @items;
}


sub _set_upload {
    my ( $self, $name, $value ) = @_;
    $log ||= get_logger( LOG_REQUEST );
    unless ( $name and $value ) {
        $log->warn( "Called set_upload() without valid params",
                    "Name '$name' Value '", ref( $value ), "'" );
        return undef;
    }
    $log->is_info &&
        $log->info( "Adding upload $name" );
    my @existing = $self->upload( $name );
    if ( ref $value eq 'ARRAY' ) {
        push @existing, @{ $value };
    }
    else {
        push @existing, $value;
    }
    $self->{_upload}{ $name } = ( scalar @existing > 1 )
                                  ? \@existing : $existing[0];
    return $self->{_upload}{ $name };
}


sub clean_uploads {
    my ( $self ) = @_;
    $log ||= get_logger( LOG_REQUEST );

    my @uploads = $self->upload;
    $log->is_info &&
        $log->info( "Cleaning all uploads: ", scalar @uploads );
    foreach my $item ( @uploads ) {
        my $filename = eval { $item->tmp_name };
        next unless ( $filename );
        unlink( $item->tmp_name ) if ( -f $filename );
    }
}

########################################
# COOKIES (INBOUND)

sub cookie {
    my ( $self, $name, $value ) = @_;
    unless ( $name ) {
        return keys %{ $self->{_cookie} };
    }
    if ( defined $value ) {
        $self->{_cookie}{ $name } = $value;
    }
    return $self->{_cookie}{ $name };
}

sub _parse_cookies {
    my ( $self, $parse_string ) = @_;
    $parse_string ||= $self->cookie_header;
    if ( $parse_string ) {
        my $cookies = OpenInteract2::Cookie->parse( $parse_string );
        while ( my ( $name, $cookie ) = each %{ $cookies } ) {
            $self->cookie( $name, $cookie->value );
        }
    }
    return $self->cookie;
}


########################################
# SESSION

# This should create at least an empty hashref...

sub _create_session {
    my ( $self ) = @_;
    my $session_id = $self->cookie( SESSION_COOKIE );
    my $session_info = CTX->lookup_session_config;
    my $oi_session_class = $session_info->{class};
    my $session = $oi_session_class->create( $session_id );
    return $self->session( $session );
}

########################################
# THEME

sub theme {
    my ( $self, $theme ) = @_;
    if ( $theme ) {
        $self->{theme} = $theme;
        $self->{theme_values} = $theme->all_values;
    }
    return $self->{theme};
}

# 'theme_values' are only settable by setting 'theme'

sub theme_values {
    my ( $self ) = @_;
    return $self->{theme_values};
}

# This should be called only after you've authenticated
# TODO: Modify to also lookup in session cache...

sub create_theme {
    my ( $self ) = @_;
    $log ||= get_logger( LOG_REQUEST );
    my $user = $self->auth_user;
    unless ( $user ) {
        $log->is_info &&
            $log->info( "Theme not created, no user authenticated" );
        oi_error "Must authenticate before trying to fetch/create theme";
    }
    my $theme_id = $user->{theme_id}
                   || CTX->lookup_default_object_id( 'theme' );
    my $theme = eval {
        CTX->lookup_object( 'theme' )->fetch( $theme_id )
    };
    if ( $@ ) {
        $log->error( "Failed to fetch theme '$theme_id': $@" );
        oi_error "Failed to fetch requested theme";
    }
    $self->theme( $theme );
    $log->is_info &&
        $log->info( "Loaded theme '$theme_id' ok, getting values" );
}


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

sub language {
    my ( $self ) = @_;
    return wantarray
           ? @{ $self->{_user_language} } : $self->{_user_language}[0];
}

sub find_language {
    my ( $self ) = @_;
    my @lang = ();
    my $lang_config = CTX->lookup_language_config;
    if ( $self->auth_is_logged_in ) {
        my $user_lang = $self->auth_user->language;
        push @lang, $user_lang if ( $user_lang );
    }
    elsif ( my $session_lang = $self->session->{language} ) {
        push @lang, ref( $session_lang ) eq 'ARRAY'
                         ? @{ $session_lang } : $session_lang;
    }
    elsif ( my @param_lang = $self->param( $lang_config->{choice_param_name} ) ) {
        push @lang, @param_lang;
    }
    else {
        push @lang, $lang_config->{default_language};
    }

    if ( my @browser_lang = $self->_find_browser_languages ) {
        push @lang, @browser_lang;
    }

    if ( my @clubber_lang = $self->_find_custom_languages( @lang ) ) {
        $self->{_user_language} = \@clubber_lang;
    }
    else {
        $self->{_user_language} = \@lang;
    }
}

sub _find_browser_languages {
    my ( $self ) = @_;
    return () unless ( $self->language_header );
    $log ||= get_logger( LOG_REQUEST );

    my @raw_lang_info = split ( /,\s+/, $self->language_header );
    my @lang_data = ();
    foreach my $lang_and_weight ( @raw_lang_info ) {
        my ( $lang, $weight ) = split( ';', $lang_and_weight );
        $weight ||= 1;
        push @lang_data, [ $lang, $weight ];
    }
    my @langs = map { $_->[0] }
                    sort { $a->[1] <=> $b->[1] } @lang_data;
    $log->is_debug &&
        $log->debug( "Found the following languages from the browser: ",
                     join( ', ', @langs ) );
    return @langs;
}

sub _find_custom_languages {
    my ( $self, @oi_lang ) = @_;
    my $lang_info = CTX->lookup_language_config;
    return unless ( $lang_info->{custom_language_id_class} );
    $log ||= get_logger( LOG_REQUEST );

    my $lang_class = $lang_info->{custom_language_id_class};
    $log->is_debug &&
        $log->debug( "Running custom lang ID class '$lang_class'" );
    my @new_langs = eval {
        $lang_class->identify_languages( @oi_lang )
    };
    if ( $@ ) {
        $log->error( "Failed to get custom languages from ",
                     "'$lang_class': $@" );
        return ();
    }
    else {
        return @new_langs;
    }
}

sub language_handle {
    my ( $self ) = @_;
    unless ( $self->{_lang_handle} ) {
        $log ||= get_logger( LOG_REQUEST );
        my @langs = $self->language;
        $log->info( "Retrieved languages for request: ", join( ', ', @langs ) );
        $self->{_lang_handle} = OpenInteract2::I18N->get_handle( @langs );
        $log->debug( "Language handle isa: ", ref( $self->{_lang_handle} ) );
    }
    return $self->{_lang_handle};
}

########################################
# FACTORY INFO

sub factory_log {
    my ( $self, @msg ) = @_;
    get_logger( LOG_REQUEST )->info( @msg );
}

sub factory_error {
    my ( $self, @msg ) = @_;
    get_logger( LOG_REQUEST )->error( @msg );
    die @msg, "\n";
}

OpenInteract2::Request->register_factory_type(
                    apache     => 'OpenInteract2::Request::Apache' );
OpenInteract2::Request->register_factory_type(
                    apache2    => 'OpenInteract2::Request::Apache2' );
OpenInteract2::Request->register_factory_type(
                    cgi        => 'OpenInteract2::Request::CGI' );
OpenInteract2::Request->register_factory_type(
                    lwp        => 'OpenInteract2::Request::LWP' );
OpenInteract2::Request->register_factory_type(
                    standalone => 'OpenInteract2::Request::Standalone' );


########################################
# OVERRIDE

# Initialize new object
sub init          { oi_error 'Subclass must implement init()' }

# Clear out current object
sub clear_current { oi_error 'Subclass must implement clear_current()' }

1;

__END__

=head1 NAME

OpenInteract2::Request - Represent a single request

=head1 SYNOPSIS

 # In server startup/OI::Context initialization
  
 OpenInteract2::Request->set_implementation_type( 'cgi' );
 
 # Later...
 use OpenInteract2::Request;
 
 my $req = OpenInteract2::Request->get_current;
 # also:
 my $req = CTX->request;
 print "All parameters: ", join( ', ', $req->param(), "\n";
 print "User agent: ", $req->user_agent(), "\n";

=head1 DESCRIPTION

This object represents all information that we know about a
request. It is modeled after the interfaces for L<CGI|CGI> and
L<Apache::Request|Apache::Request>, so there are a couple of items
that are slightly inconsistent with the rest of OpenInteract.

When you create a new request object you need to specify what type of
request it is. (Your OpenInteract server configuration should have
this specified in the 'context_info' section.) The process of
initializing the object during the C<new()> call fills the Request
object with any parameters, uploaded files and important headers from
the client.

The L<OpenInteract2::Context|OpenInteract2::Context> object is
responsible for associating cookies and the session with this request
object.

=head1 METHODS

=head2 Class Methods

B<set_implementation_type( $type )>

B<get_implementation_type()>

B<new( @params )>

=head2 Parameters

B<param( [ $name, $value ] )>

With no arguments, this returns a list -- not an arrayref! -- of
parameters the client passed in.

If you pass in C<$name> by itself then you get the value(s) associated
with it. If C<$name> has not been previously set you get an empty list
or undef depending on the context. Otherwise, we return the
context-sensitive value of C<$name>

If you pass in a C<$value> along with C<$name> then it is assigned to
C<$name>, overwriting whatever may have been there before.

Returns: list of parameters (no argument), the parameter associated
with the first argument (one argument, two arguments),

B<param_toggled( $name )>

Given the name of a parameter, return 'yes' if it is defined and 'no'
if not.

B<param_date( $name, [ $strptime_format ]  )>

Given the name of a parameter return a L<DateTime|DateTime> object
populated with the data input from the HTTP request.

The parameter C<$name> can refer to:

=over 4

=item 1.

a single field, in which case you must specify a strptime format in
C<$format>

=item 2.

multiple fields where C<$name> is a prefix and '_year', '_month',
'_day' are the suffixes.

=back

For example:

 # mydate = '2003-04-01'
 my $datetime = $request->param_date( 'mydate', '%Y-%m-%d' );
 
 # mydate_year  = '2003'
 # mydate_month = '04'
 # mydate_day   = '01'
 my $datetime = $request->param_date( 'mydate' );

If you specify a format and the parser cannot parse the date you give
with that format an exception will be thrown.

B<param_datetime( $name, [ $format ] )>

Similar to C<param_date> in that it reads parameter information and
returns a L<DateTime|DateTime> object, except it also reads hour,
minute and AM/PM information.

The parameter C<$name> can refer to:

=over 4

=item 1.

a single field, in which case you must specify a strptime format in
C<$format>

=item 2.

multiple fields where C<$name> is a prefix and '_year', '_month',
'_day', '_hour', '_minute' and '_am_pm' are the suffixes.

=back

For example:

 # mytime = '2003-04-01 6:08 PM'
 my $datetime = $request->param_date( 'mytime', '%Y-%m-%d %I:%M %p' );
 
 # mytime_year   = '2003'
 # mytime_month  = '04'
 # mytime_day    = '01'
 # mytime_hour   = '6'
 # mytime_minute = '08'
 # mytime_am_pm  = 'PM'
 my $datetime = $request->param_datetime( 'mytime' );

If you specify a format and the parser cannot parse the date you give
with that format an exception will be thrown.

=head2 Request URL

B<assign_request_url( $full_url_path )>

This method is normally only called by the implementing subclass. The
subclass should pass the full, absolute URL path (no protocol, host or
port) so the C<url_absolute> and C<url_relative> properties are
properly set. This also sets the action name and task for use by the
controller.

If you want to do any behind-the-scenes redirection before the
L<OpenInteract2::Controller|OpenInteract2::Controller> is
instantiated, you can pass a path to this and the correct action will
be processed. For instance, you can configure your site to force users
to login, so no matter what URL is requested by a user who is not
logged in they will always get your login page. This is done in the
L<OpenInteract2::Auth|OpenInteract2::Auth> class -- if the user is not
logged in it assigns a new request URL which changes the action
processed by the controller.

=head2 Incoming Cookies

B<cookie( [ $name, $value ] )>

With no arguments it returns a list -- not an arrayref! -- of cookie
names the client passed in.

If you pass in C<$name> by itself you get the value associated with
the cookie. This is a simple scalar value associated with the name,
not a L<CGI::Cookie|CGI::Cookie> object.

If you pass in a C<$value> along with C<$name> then it is assigned to
C<$name>, overwriting whatever may have been there before.

B<Note>: These are only incoming cookies, those the client sends to
the server. For outgoing cookies (setting cookies on the client from
the server) see L<OpenInteract2::Response|OpenInteract2::Response>.

Returns: list of cookie names (no argument), the value associated with
the first argument (one argument, two arguments).

=head2 Incoming Uploads

B<upload( [ $name ] )>

With no arguments, this returns a list -- B<not> an arrayref! -- of
L<OpenInteract2::Request::Upload|OpenInteract2::Request::Upload> objects
mapping to the files uploaded by the client. If you pass in C<$name>
then you get the specific
L<OpenInteract2::Request::Upload|OpenInteract2::Request::Upload> object
associated with it.

Returns: list of parameters (no argument), or the parameter associated
with the single argument.

B<clean_uploads()>

Deletes all uploads associated with the request.

=head2 Language/Localization

B<language()> (read-only)

Returns the language(s) chosen for this particular request. This is
one of the few context-sensitive properties. If called in list context
it will return a list of all languages supported in this request, even
if only one is available. If called in scalar context it will return
the first (and presumably most important) language.

See L<OpenInteract2::Manual::I18N|OpenInteract2::Manual::I18N> for how
we find the language(s) desired for this request.

B<language_handle()> (read-only)

A L<Locale::Maketext|Locale::Maketext> object from which you can get
localized messages.

=head2 Properties

B<url_absolute>

This is set to the URL the user entered, still containing the
deployment context.

B<url_relative>

This is set to the internal URL OI uses. It does not include the
deployment context. It should be the URL all actions deal with.

B<url_initial>

This is the URL we used to lookup the action.

B<theme>

Theme object associated with this request. May change if user is
logged in and has different theme.

B<theme_values> (read-only)

Hashref (not an object) of flattened theme properties. This is set
automatically when C<theme> property is set.

B<session>

The stateful session for the current user.

B<action_name>

Name of the action as gleaned from the URL. (May be empty, may change
as a result of lookups.)

B<task_name>

Task of the action as gleaned from the URL. (May be empty, may change
as a result of lookups.)

B<auth_user>

User logged in (or not) for this request. This should B<always> be
filled with a user object, even if it is the 'not-logged-in' user.

B<auth_group>

Groups current user belongs to. May be empty.

B<auth_is_admin>

True if current user is an administrator, false if not. (You can
customize this: see
L<OpenInteract2::Auth::AdminCheck|OpenInteract2::Auth::AdminCheck>).

B<auth_is_logged_in>

True if current user is a legitimate user, false if it is the
'not-logged-in' user.

B<auth_user_id>

Shortcut so you do not have to test whether the user is logged in to
get an ID. If the user is not logged in, you get a '0' back.

B<auth_clear>

Clears out all the 'auth_*' properties to undef -- generally only used
when you want to log a user out for the current request.

B<server_name>

Hostname of our server.

B<remote_host>

Client IP address or hostname connecting to us.

B<user_agent>

The browser identification string. (May be empty, forged, etc.)

B<referer>

URL (string) where the user came from. (May be empty, forged, etc.)

=head2 Action Messages

Actions or other code can leave messages for other actions. These
messages are typically tagged errors so the action and/or view knows
how to sort through them, but it is not required. For instance, if a
login fails we want to be able to indicate this so that the login box
can display the right type of error message. Normally you would set
the messages directly in the action (via C<add_view_message()>), but
in the (fairly rare) case where the two are disconnected you can
deposit error messages in the request and the relevant action will
know where to pick them up when it is later instantiated.

B<action_messages( $action_name, [ \%messages ] )>

Retrieve hashref of messages for action C<$action_name>,
case-insensitive. Overwrite all existing messages with C<\%messages>
if it is provided.

Returns: hashref of action messages for action C<$action_name>; empty
hashref if C<$action_name> not provided.

B<add_action_message( $action_name, $msg_name, $msg )>

Adds an individual message C<$msg_name> with message C<$msg> to
C<$action_name>. The C<$msg_name> may be whatever you like, but
frequently it is an object field name.

Returns: C<$msg> set

=head1 SUBCLASSING

If you're extending OpenInteract to a new architecture and need to
create a request adapter it is probably best to look at an existing one
to see what it does. (Working code is always more up-to-date than
documentation...) That said, here are a few tips:

=over 4

=item *

If your architecture is deployed under a particular URL you should set
this as soon as possible. Do so using the C<assign_deploy_url()>
method of the context. See
L<OpenInteract2::Request::CGI|OpenInteract2::Request::CGI> for an
example.

=back

Other than that take a look at
L<OpenInteract::Request::Standalone|OpenInteract::Request::Standalone>. It
forces you to deal with parameters and file uploads yourself, but it
may be the path of least resistance.

=head2 Methods

B<_set_upload( $name, $upload )>

Associates the
L<OpenInteract2::Request::Upload|OpenInteract2::Request::Upload>
C<$upload> object with C<$name>.

Returns: the upload object

=head2 Parent initialization

B<_parse_cookies()>

Reads the C<cookie_header> property and parses it into the name/value
pairs returned from the C<cookie()> method. So your adapter must set
this header to have the cookies created and/or create the cookies
yourself using
C<cookie()>. (L<OpenInteract2::Request::Standalone|OpenInteract2::Request::Standalone>
is an example of doing both)

B<_create_session()>

Reads in the cookie with the name defined in the constant
C<SESSION_COOKIE> from
L<OpenInteract2::Constants|OpenInteract2::Constants> and uses its
value as the session ID passed to
L<OpenInteract2::SessionManager|OpenInteract2::SessionManager> to
create the session, which is stored in the C<session> property.

B<_find_language()>

...


=head1 SEE ALSO

L<Class::Factory|Class::Factory>

L<OpenInteract2::Request::Apache|OpenInteract2::Request::Apache>

L<OpenInteract2::Request::CGI|OpenInteract2::Request::CGI>

L<OpenInteract2::Request::LWP|OpenInteract2::Request::LWP>

L<OpenInteract2::Request::Standalone|OpenInteract2::Request::Standalone>

=head1 COPYRIGHT

Copyright (c) 2002-2004 Chris Winters. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHORS

Chris Winters E<lt>chris@cwinters.comE<gt>
