1# We're importing right into the RequestHolder as a simplistic mixin
2package Continuity::RequestHolder;
3
4=head1 NAME
5
6Continuity::RequestCallbacks - Mix callbacks into the Continuity request object
7
8=head1 SYNOPSYS
9
10  use Continuity;
11  use Continuity::RequestCallbacks;
12
13  Continuity->new->loop;
14
15  sub main {
16    my $request = shift;
17    my $link_yes = $request->callback_link( Yes => sub {
18      $request->print("You said yes! (please reload)");
19      $request->next;
20    });
21    my $link_no = $request->callback_link( No => sub {
22      $request->print("You said no! (please reload)");
23      $request->next;
24    });
25    $request->print(qq{
26      Do you like fishies?<br>
27      $link_yes $link_no
28    });
29    $request->next;
30    $request->execute_callbacks;
31    $request->print("All done here!");
32  }
33
34=head1 DESCRIPTION
35
36This adds some methods to the $request object so you can easily do some callbacks.
37
38=cut
39
40use strict;
41
42# This holds our current callbacks
43sub callbacks { exists $_[1] ? $_[0]->{callbacks} = $_[1] : $_[0]->{callbacks} }
44
45=head1 METHODS
46
47=head2 $html = $request->callback_link( "text" => sub { ... } );
48
49Returns the HTML for an href callback.
50
51=cut
52
53sub callback_link {
54  my ($self, $text, $subref) = @_;
55  my $name = scalar $subref;
56  $name =~ s/CODE\(0x(.*)\)/callback-link-$1/;
57  $self->callbacks({}) unless defined $self->callbacks;
58  $self->callbacks->{$name} = $subref;
59  return qq{<a href="?$name=1">$text</a>};
60}
61
62=head2 $html = $request->callback_submit( "text" => sub { ... } );
63
64Returns the HTML for a submit button callback.
65
66=cut
67
68sub callback_submit {
69  my ($self, $text, $subref) = @_;
70  my $name = scalar $subref;
71  $name =~ s/CODE\(0x(.*)\)/callback-submit-$1/;
72  $self->callbacks({}) unless defined $self->callbacks;
73  $self->callbacks->{$name} = $subref;
74  return qq{<input type=submit name="$name" value="$text">};
75}
76
77=head2 $request->execute_callbacks
78
79Execute callbacks, based on the params in C<< $request >>. Call this after
80you've displayed the form and then done C<< $request->next >>.
81
82We don't call this from within C<< $request->next >> in case you need to do
83some processing before executing callbacks. Checking authentication is a good
84example of something you might be doing in between :)
85
86By default the callbacks are cleared with ->clear_callbacks after all callbacks
87are processed. If you'd like, you can pass a hashref with a flag to indicate
88that the remaining callbacks shouldn't be cleared, like this:
89
90  $request->execute_callbacks( { no_clear_all => 1 } );
91
92You might want to do this if, for example, you are doing some AJAX and don't
93want one js component clearing the callbacks of another. It is most likely a
94bad idea though due to the ensuing memory leak. If it makes you feel any
95better, you can pass "clear_executed" in the same way to clear at least some,
96preventing double-execution. You'd probably use both flags:
97
98  $request->execute_callbacks( { no_clear_all => 1, clear_executed => 1 } );
99
100=cut
101
102sub execute_callbacks {
103  my ($self, $options) = @_;
104  foreach my $callback_name (keys %{ $self->callbacks }) {
105    if($self->param($callback_name)) {
106      $self->callbacks->{$callback_name}->($self, @_);
107      delete $self->callbacks->{$callback_name} if $options->{clear_executed};
108    }
109    delete $self->callbacks->{$callback_name} unless $options->{no_clear_all};
110  }
111}
112
113=head2 $request->clear_callbacks
114
115Explicitly clear the current list of callbacks. This is already called at the
116end of execute_callbacks. It additionally exists here in case you want to clear
117the callbacks without processing.
118
119=cut
120
121sub clear_callbacks {
122  my $self = shift;
123  $self->callbacks({}); # Clear all callbacks
124}
125
1261;
127
128