view release on metacpan or  search on metacpan

lib/App/Session/HTMLHidden.pm  view on Meta::CPAN

        $html .= "-->\n";
    }

    my $app = $options->{"app"};
    my $cookie_attribs = $options->{"app.Session.cookie_attribs"};
    if ($cookie_attribs) {
        my $cookiedata = {};
        foreach my $cookie_attrib (split(/[ ,;]+/, $cookie_attribs)) {
            if ($cookie_attrib =~ /^([^-]+)-(.+)$/) {
                $cookiedata->{$1}{$2} = $sessiondata->{SessionObject}{$1}{$2};
            }
            elsif ($cookie_attrib) {
                $cookiedata->{default}{$cookie_attrib} = 
                    $sessiondata->{SessionObject}{default}{$cookie_attrib};
            }
        }

        my $cgi    = $self->{context}->request()->{cgi};
        my $secure = ($cgi->url() =~ /^https/) ? "; secure" : "";

        my $cookietext = MIME::Base64::encode(Compress::Zlib::memGzip(freeze($cookiedata)));
        $cookietext =~ s/\n//g;  # get rid of newlines (76 char lines)
        my $cookie_options = $options->{"app.Session.cookie_options"} || "$secure";
        my $headers = "Set-Cookie: app_session_${app}_persist=$cookietext$cookie_options\n";
        $self->{context}->set_header($headers);
    }

    &App::sub_exit($html) if ($App::trace);
    $html;
}

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

=head1 Protected Methods:

The following methods are intended to be called by subclasses of the
current class.

=cut

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

=head2 _init()

The _init() method is called from within the constructor.

    * Signature: _init($named)
    * Param:     $named        {}    [in]
    * Return:    void
    * Throws:    App::Exception
    * Since:     0.01

    Sample Usage: 

    $ref->_init($args);

The _init() method looks at the CGI variables in the request
and restores the session state information from the variable
named "app.sessiondata" (and "app.sessiondata[2..n]").

When the values of these variables are concatenated, they
form a Base64-encoded, gzipped, frozen multi-level hash of
session state data.  To retrieve the state data, the text
is therefore decoded, gunzipped, and thawed (a la Storable).

TODO: encrypt and MAC

=cut

sub _init {
    &App::sub_entry if ($App::trace);
    my ($self, $args) = @_;
    my ($cgi, $sessiontext, $store, $request);

    $self->{context} = $args->{context};
    $store = {};
    $cgi = $args->{cgi} if (defined $args);

    eval {
        $request = $self->{context}->request();
    };
    # ignore it if it fails

    if (!defined $cgi) {
        $cgi = $request->{cgi} if ($request);
    }

    if (defined $cgi) {
        $sessiontext = $cgi->param("app.sessiondata");
        if ($sessiontext) {
            my ($i, $textchunk);
            $i = 2;
            while (1) {
                $textchunk = $cgi->param("app.sessiondata${i}");
                last if (!$textchunk);
                $sessiontext .= $textchunk;
                $i++;
            }
            $store = thaw(Compress::Zlib::memGunzip(decode_base64($sessiontext)));
        }
    }

    if ($request) {
        my $options = $self->{context}{options};
        my $cookie_attribs = $options->{"app.Session.cookie_attribs"};
        if ($cookie_attribs) {
            my $cookiedata = {};

            my $app = $options->{"app"};
            my $cookietext = $cgi->cookie("app_session_${app}_persist");
            if ($cookietext) {
                $cookietext =~ s/ /\+/g;
                my $length = length($cookietext);
                my $pad = 4 - ($length % 4);
                $pad = 0 if ($pad == 4);
                $cookietext .= ("=" x $pad) if ($pad);
                $cookietext =~ s/(.{76})/$1\n/g;