The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Plack::Session::State::URI;
use strict;
use warnings;
our $VERSION = '0.06';

use parent 'Plack::Session::State';
use Plack::Request;
use Plack::Util;
use Encode ();
use HTML::StickyQuery;

sub get_session_id {
    my ($self, $env) = @_;
    Plack::Request->new($env)->param($self->session_key);
}

sub finalize {
    my ($self, $id, $res) = @_;

    return unless $id;

    if ($res->[0] == 200) {
        $self->html_filter($id, $res);
    } elsif ($res->[0] == 302) {
        $self->redirect_filter($id, $res);
    }
}

sub html_filter {
    my ($self, $id, $res) = @_;

    return if (ref $res->[2]) ne 'ARRAY';

    my $encode = 'utf8';
    my $h = Plack::Util::headers($res->[1]);
    if ($h->get('Content-Type')=~m|^text/\w+;\s*charset="?([^"]+)"?|i) {
        $encode = $1;
    }
    my $name = $self->session_key;
    my $body = '';
    for my $line (@{ $res->[2] }) {
        $body .= $line if length $line;
    }
    $body = Encode::decode($encode, $body);
    $body =~ s{(<form\s*.*?>)}{$1\n<input type="hidden" name="$name" value="$id" />}isg;
    my $sticky = HTML::StickyQuery->new;
    $body = $sticky->sticky(
        scalarref => \$body,
        param     => { $name => $id }
    );
    $res->[2] = [ Encode::encode($encode, $body) ];
}

sub redirect_filter {
    my ($self, $id, $res) = @_;

    my $h = Plack::Util::headers($res->[1]);
    my $path = $h->get('Location');
    my $uri = URI->new($path);
    $uri->query_form( $uri->query_form, $self->session_key, $id );
    $h->set('Location', $uri->as_string);
}

1;
__END__

=head1 NAME

Plack::Session::State::URI - uri-based session state

=head1 SYNOPSIS

  use Plack::Builder;
  use Plack::Session::Store::File;
  use Plack::Session::State::URI;

  my $app = sub {
      return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ];
  };

  builder {
      enable 'Plack::Middleware::Session',
          store => Plack::Session::Store::File->new(
              dir => File::Temp->tempdir( 'XXXXXXXX', TMPDIR => 1, CLEANUP => 1 )
          ),
          state => Plack::Session::State::URI->new(
              session_key => 'sid'
          );
      $app;
  };

=head1 DESCRIPTION

Plack::Session::State::URI is uri-based session state

=head1 AUTHOR

Shinichiro Aska E<lt>s.aska.org {at} gmail.comE<gt>

=head1 SEE ALSO

=head1 LICENSE

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

=cut