Jifty::Continuation - Allows for basic continuation-based programming

use warnings;
use strict;

package Jifty::Continuation;

use Storable 'dclone';
$Storable::Deparse = 1;
$Storable::Eval = 1;
$Storable::forgive_me = 1;

use base qw/Class::Accessor::Fast Jifty::Object/;

__PACKAGE__->mk_accessors(qw(id parent
                             request response code
                             version
                             ));

sub new {
    my $class = shift;
    my $self = bless { }, $class;

    my %args = (
                parent   => Jifty->web->request->continuation,
                request  => Jifty::Request->new(),
                response => Jifty::Response->new(),
                code     => undef,
                @_,
                version  => 2,
               );

    # We don't want refs
    $args{parent} = $args{parent}->id
      if $args{parent} and ref $args{parent};

    # We're getting most of our properties from the arguments
    for (keys %args) {
        $self->$_($args{$_}) if $self->can($_);
    }

    # Generate a hopefully unique ID
    # FIXME: use a real ID
    my $key = Jifty->web->serial . "_" . int(rand(10)) . int(rand(10)) . int(rand(10)) . int(rand(10)) . int(rand(10)) . int(rand(10));
    $self->id($key);

    # Make sure we don't store any of the connection information
    my $req = $self->request;
    local $req->{env};
    local $req->{_body_parser}{input_handle} if defined $req->{_body_parser};
    # We may also need to clean out the top request, if this is a subrequest
    $req = $req->top_request;
    local $req->{env};
    local $req->{_body_parser}{input_handle} if defined $req->{_body_parser};

    # Save it into the session
    Jifty->web->session->set_continuation($key => $self);

    return $self;
}

sub return_path_matches {
    my $self = shift;

    return unless Jifty->web->request->path eq $self->request->path
        or Jifty->web->request->path eq $self->request->uri->canonical->path;

    my $args = Jifty->web->request->arguments;
    return unless scalar keys %{$args} == 1;

    return unless exists $args->{"J:RETURN"} and $args->{"J:RETURN"} eq $self->id;

    return 1;
}

sub call {
    my $self = shift;

    $self->log->debug("Redirect to @{[$self->request->path]} via continuation");
    if (Jifty->web->request->argument('_webservice_redirect')) {
        # for continuation - perform internal redirect under webservices.
        Jifty->web->webservices_redirect($self->request->path);
        return;
    }

    # If we needed to fix up the path (it contains invalid
    # characters) then warn, because this may cause infinite
    # redirects
    $self->log->warn("Redirect to '@{[$self->request->path]}' contains unsafe characters")
        if $self->request->path =~ m{[^A-Za-z0-9\-_.!~*'()/?&;+%]};

    # Clone our request
    my $request = $self->request->clone;

    # Fill in return value(s) into correct part of $request
    $request->do_mapping;

    my $response = $self->response;

    # If the current response has results, we need to pull them
    # in.  For safety, monikers from the saved continuation
    # override those from the request prior to the call
    if (Jifty->web->response->results) {
        $response = dclone(Jifty->web->response);
        my %results = $self->response->results;
        $response->result($_ => $results{$_}) for keys %results;
    }

    # Make a new continuation with that request
    my $next = Jifty::Continuation->new(parent => $self->parent, 
                                        request => $request,
                                        response => $response,
                                        code => $self->code,
                                       );
    $next->request->continuation(Jifty->web->session->get_continuation($next->parent))
        if defined $next->parent;

    # Redirect to right page if we're not there already
    # $next maybe only set path
    my $path =
      $next->request->request_uri
      ? URI->new( $next->request->request_uri )->path
      : $next->request->path;
    Jifty->web->_redirect($path . "?J:RETURN=" . $next->id);
    return 1;
}

sub return {
    my $self = shift;

    # Pull state information out of the continuation and set it
    # up; we use clone so that the continuation itself is
    # immutable.
    Jifty->web->response(dclone($self->response));

    # Run any code in the continuation
    $self->code->(Jifty->web->request)
      if $self->code;

    # We want to preserve the current actual request environment
    # (headers, etc)
    my $env = Jifty->web->request->top_request->env;

    # Set the current request to the one in the continuation
    Jifty->web->request($self->request->clone);

    # Restore the environment we came in with
    Jifty->web->request->top_request->{env} = $env;
    Jifty->web->request->setup_subrequest_env
        if Jifty->web->request->is_subrequest;

    return Jifty->web->request;
}

sub delete {
    my $self = shift;

    # Remove all continuations that point to me
    my %continuations = Jifty->web->session->continuations;
    $_->delete for grep {$_->parent eq $self->id} values %continuations;

    # Finally, remove me from the list of continuations
    Jifty->web->session->remove_continuation($self->id);

}

1;