view release on metacpan or  search on metacpan

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

    $sessiondata = $self->{store};
    $sessiontext = encode_base64(Compress::Zlib::memGzip(freeze($sessiondata)));

    my ($maxvarsize, $maxvarlines);
    $maxvarlines = 24;
    $maxvarsize = $maxvarlines*77;  # length of a MIME/Base64 line is (76 chars + newline)

    if (length($sessiontext) <= $maxvarsize) {
        $html = "<input type=\"hidden\" name=\"app.sessiondata\" value=\"\n$sessiontext\">";
    }
    else {
        my (@sessiontext, $i, $startidx, $endidx, $textchunk);
        @sessiontext = split(/\n/,$sessiontext);
        $i = 1;
        $startidx = 0;
        $endidx = $startidx+$maxvarlines-1;
        $textchunk = join("\n",@sessiontext[$startidx .. $endidx]);
        $html = "<input type=\"hidden\" name=\"app.sessiondata\" value=\"\n$textchunk\n\">";
        while ($endidx < $#sessiontext) {
            $i++;
            $startidx += $maxvarlines;
            $endidx = $startidx+$maxvarlines-1;
            $endidx = $#sessiontext if ($endidx > $#sessiontext-1);
            $textchunk = join("\n",@sessiontext[$startidx .. $endidx]);
            $html .= "\n<input type=\"hidden\" name=\"app.sessiondata${i}\" value=\"\n$textchunk\n\">";
        }
    }
    $html .= "\n";

    $options = $self->{context}->options();
    if ($options && $options->{show_session}) {
        # Debugging Only
        my $d = Data::Dumper->new([ $sessiondata ], [ "session_store" ]);
        $d->Indent(1);
        $html .= "<!-- Contents of the session. (For debugging only. Should be turned off in production.)\n";
        $html .= $d->Dump();
        $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;
                $cookietext .= "\n";
                #print "Session::Cookie->_init(): sessiontext = [\n$sessiontext\n]\n";
                $cookiedata = thaw(Compress::Zlib::memGunzip(MIME::Base64::decode($cookietext)));
            }

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

    $self->{context} = $args->{context} if (defined $args->{context});
    $self->{store} = $store;
    $self->{cache} = {};
    &App::sub_exit() if ($App::trace);
}

1;