view release on metacpan or  search on metacpan

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

#############################################################################
## $Id: HTMLHidden.pm 13887 2010-04-06 13:36:42Z spadkins $
#############################################################################

package App::Session::HTMLHidden;
$VERSION = (q$Revision: 13887 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use App;
use App::Session;
@ISA = ( "App::Session" );

use strict;

use Data::Dumper;
use Storable qw(freeze thaw);
use Compress::Zlib;
use MIME::Base64;

# note: We may want to apply an HMAC (hashed message authentication code)
#       so that users cannot fiddle with the values.
#       We may also want to add IP address and timeout for security.
#       We may also want to add encryption so they can't even decode the data.
# use Digest::HMAC_MD5;
# use Crypt::CBC;

=head1 NAME

App::Session::HTMLHidden - a session whose state is maintained across
HTML requests by being embedded in an HTML <input type="hidden"> tag.

=head1 SYNOPSIS

   # ... official way to get a Session object ...
   use App;
   $session = App->session();
   $session = $session->session();   # get the session

   # any of the following named parameters may be specified
   $session = $session->session(
   );

   # ... alternative way (used internally) ...
   use App::Session::HTMLHidden;
   $session = App::Session->new();

=cut

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

=head1 DESCRIPTION

A Session class models the sequence of events associated with a
use of the system.  These events may occur in different processes.
Yet the accumulated state of the session needs to be propagated from
one process to the next.

This Session::HTMLHidden maintains its state across
HTML requests by being embedded in an HTML <input type="hidden"> tag.
As a result, it requires no server-side storage, so the sessions
never need to time out.

=cut

#############################################################################
# CONSTRUCTOR METHODS
#############################################################################

=head1 Constructor Methods:

=cut

#############################################################################

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

    return($session_id);
}

#############################################################################
# html()
#############################################################################

=head2 html()

The html() method ...

    * Signature: $html = $session->html();
    * Param:  void
    * Return: $html      string
    * Throws: <none>
    * Since:  0.01

    Sample Usage: 

    $session->html();

=cut

sub html {
    &App::sub_entry if ($App::trace);
    my ($self) = @_;
    my ($sessiontext, $sessiondata, $html, $options);

    $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: