[cgiapp] [patch] CAP::MessageStack + CAP::FormState

Alex capfan at gmx.de
Mon Oct 12 13:23:06 EDT 2009


Hi!

I looked into this timing issue. Without any modifications, the patched
version as I send it to cpan tells me something like this (average)::
$VAR1 = { 'with_check' => bless( [ 0, '0.100', 0, 0, 0, 100 ], 'Benchmark' )
};

So I worked out my todo and the condition when the check is done. It's now a
two-row if statement.
If I modifiy my "catch the case when we need to query the template" I get
this (average):
$VAR1 = { 'with_check' => bless( [ 0, '0.062', 0, 0, 0, 100 ], 'Benchmark' )
};

Using the unpatched version, there is this result:
$VAR1 = { 'with_check' => bless( [ 0, '0.078', 0, 0, 0, 100 ], 'Benchmark' )
};

I don't have any idea what this numbers mean, but they are done with
Benchmark.pm and I consider the lesser numbers good numbers. Please correct
me if I'm wrong.

Here is a sniplet of what was producing these numbers. See the scripts below
for full code.
[code]
    # Use Perl code in strings...
	my $count = 100;
    my $results = timethese($count, {
        'with_check' => sub{ my $t = $self->load_tmpl(\$html); },
    });
[/code]

Concerning the it's not a bug, it's a prerequisite-thing:
Well, it's true that the incompatibility with the default templating engine
with default options is documented and the usage is to turn off
die_on_bad_params or use another templating engine. Strictly, it is not a
bug anymore.
But I personally consider it a bug. It's like someone telling me to upgrade
a software to achieve a functionality that should be provided anyways. I
simply don't see why I should change default behavior to be able to use some
functionality, when there is a way I could use it (the functionality) while
keeping the defaults (that’s where my patch comes in). 

I also looked into CAP::TT. They define these hooks tt_pre_process and
tt_post_process on their own, wrapping it around the load_tmpl part. Having
a quick look at the CA source code, I didn't see any way to achieve a post
template processing without altering CA itself. With FormState, there would
be two modules which would benefit from this change. But: you would change
the core, to add non-core features. I would prefer to apply my patch rather
than changing CA because it would affect less people (no offense).

Enough human readable, text, here is source code.

There is the new patched version of MessageStack and two instance scripts.
run2.cgi using the current CAP::MessateStack and run.cgi using the patched
version.

There is a runmode timing where the benchmark is done. As I din't have any
experience with benchmarks, maybe someone else should investigate such
things a bit further.



****************************************************************************
*********
./lib/CGI/Application/Plugin/MessageStack.pm:
[code]
package CGI::Application::Plugin::MessageStack;

use CGI::Application 4.01;

use 5.006;
use warnings;
use strict;
use HTML::Template; # required by CGI::Application anyway

=head1 NAME

CGI::Application::Plugin::MessageStack - A message stack for your
CGI::Application

=head1 VERSION

Version 0.34

=cut

use vars qw( @ISA $VERSION @EXPORT %config );

@ISA = qw( Exporter AutoLoader );

@EXPORT = qw(
    push_message
    pop_message
    clear_messages
    messages
    capms_config
);

sub import {
    my $caller = scalar( caller );
    $caller->add_callback( 'load_tmpl' => \&_pass_in_messages );
    goto &Exporter::import;
}

$VERSION = '0.35';

=head1 SYNOPSIS

This plugin gives you a few support methods that you can call within your
cgiapp
to pass along messages between requests for a given user.

 use CGI::Application::Plugin::Session;
 use CGI::Application::Plugin::MessageStack;

 sub mainpage {
   my $self = shift;
   my $template = $self->load_tmpl( 'mainpage.TMPL', 'die_on_bad_params' =>
0 );
   # ...
   $template->output;
 }

 sub process {
   my $self = shift;
   $self->push_message(
       -scope          => 'mainpage',
       -message        => 'Your listing has been updated',
       -classification => 'INFO',
     );
   $self->forward( 'mainpage' );
 }

 sub cgiapp_init {
   # setup your session object as usual...
 }

Meanwhile, in your (HTML::Template) template code:

 ...
 <style type="text/css">
   .INFO {
     font-weight: bold;
   }
   .ERROR {
     color: red;
   }
 </style>
 ...
 <h1>Howdy!</h1>
 <!-- TMPL_LOOP NAME="CAP_Messages" -->
   <div class="<!-- TMPL_VAR NAME="classification" -->">
     <!-- TMPL_VAR NAME="message" -->
   </div>
 <!-- /TMPL_LOOP -->
 ...

It's a good idea to turn off 'die_on_bad_params' in HTML::Template - in case
this plugin tries to put in the parameters and they're not available in your
template.

Here's a quick TT example:

 <style type="text/css">
   .INFO {
     font-weight: bold;
   }
   .ERROR {
     color: red;
   }
 </style>
 ...
 <h1>Howdy!</h1>
 [% FOREACH CAP_Messages %]
    <div class="[% classification %]">[% message %]</div>
 [% END %]
 ...

If you use TT, I recommend using CAP-TT and a more recent version (0.09),
which supports cgiapp's load_tmpl hook and then this plugin will
automatically supply TT with the relevant messages.  Your runmode could be
this simple:

 sub start {
     my $self = shift;
     my $session = $self->session;
     return $self->tt_process( 'output.tt' );
 }

I don't have the experience to weigh in on how you'd do this with other
templates (HTDot, Petal), but basically, this plugin will put in a loop
parameter called 'CAP_Messages'.  Within each element of that loop, you'll
have two tags, 'classification' and 'message'.

NOTE: I have broken backwards compatibility with this release (0.30) and the
loop parameter's default name is now 'CAP_Messages'.  If you used the old
__CAP_Messages or want to use another name, feel free to use the
capms_config to override the C<-loop_param_name>.

=head1 DESCRIPTION

This plugin by default needs a session object to tuck away the message(s).
It's recommended that you use this in conjunction with
CGI::Application::Plugin::Session.  You can opt to not have the messages
persist and thereby, not use CAP-Session by using the C<-dont_use_session>
option in the C<capms_config> method.

This plugin hooks into cgiapp's load_tmpl method and if you've pushed any
messages in the stack, will automatically add the message parameters.

In the functions, there are scope & classification keys and when they're
used for either display or your API purposes (clearing, pop'ing, etc), the
classification is an exclusive specification.  Meaning, if you ask for
messages with the 'ERROR' classification, it will only deal with messages
that you've pushed in with the 'ERROR' classification.  Any messages that
have no classification aren't included.

The scope key is not exclusive, meaning that if you ask for messages with a
'mainpage' scope, it will deal with messages that you've pushed with that
scope B<as well as> any messages that you've pushed in without a scope.

If you use both scope & classification, it blends both of those rules, first
getting all matching messages with the same classification and then
filtering out messages that are scoped and don't match the scope you're
looking for.

This logic may change as I get feedback from more saavy developers.  What we
may end up doing is have a plugin configuration where you can dictate the
logic that's used.

=head1 FUNCTIONS

=head2 push_message

 $self->push_message(
     -scope          => 'mainpage',
     -message        => 'Your listing has been updated',
     -classification => 'INFO',
   );

You provide a hash to the push_message() method with three possible keys:

=over

=item * message - a text message.  You can put HTML in there - just make
sure you don't use the ESCAPE=HTML in your HTML::Template code

=item * scope - which runmode(s) can this message appear?  If you want to
specify just one, use a scalar assignment.  Otherwise, use an array
reference with the list of runmodes.

=item * classification - a simple scalar name representing the
classification of your message (i.e. 'ERROR', 'WARNING' ... ).  This is very
useful for CSS styles (see template example above).

=back

The scope & classification keys are optional.  If you don't provide a scope,
it will assume a global presence.

=cut

sub push_message {
    my $self = shift;
    my $session = _check_for_session( $self );
    my %message_hash = @_;
    if ( my $message_array = $session->param( '__CAP_MessageStack_Stack' ) )
{
        push @$message_array, \%message_hash;
        $session->param( '__CAP_MessageStack_Stack' => $message_array );
    } else {
        $session->param( '__CAP_MessageStack_Stack' => [ \%message_hash ] );
    }
}

=head2 messages

 my @messages = $self->messages();
 my @messages = $self->messages( -scope => 'mainpage' );
 my @messages = $self->messages( -scope => 'mainpage', -classification =>
'ERROR' );
 my @messages = $self->messages( -classification => 'ERROR' );

If you want to take a gander at the message stack data structure, you can
use this method.

Optionally, you can use a hash parameters to get a slice of the messages,
using the same keys as specified in the push_message() method.

It will return an array reference of the matching messages or 'undef', if
there's either no messages in the stack or no messages that match your
specification(s).

=cut

sub messages {
    my $self = shift;
    my $session = _check_for_session( $self );
    my %limiting_params = @_;
    my $message_array = $session->param( '__CAP_MessageStack_Stack' ) || [];
    if ( $limiting_params{'-scope'} || $limiting_params{'-classification'} )
{
        $message_array = _filter_messages( $message_array, \%limiting_params
)
    } else {
        # if the dev config'd different message or classification names, i
need to do
        # 'em by hand here ... _filter_messages() would do that, but only if
they
        # wanted a slice.  This is if they want everything.
        if ( my $class_key = $config{'-classification_param_name'} ) {
            map {
                    if ( $_->{'-classification'} ) {
                        $_->{$class_key} = $_->{'-classification'};
                        delete $_->{'-classification'};
                    }
                } @$message_array;
        }
        if ( my $message_key = $config{'-message_param_name'} ) {
            map {
                    if ( $_->{'-message'} ) {
                        $_->{$message_key} = $_->{'-message'};
                        delete $_->{'-message'};
                    }
                } @$message_array;
        }
    }

    return $message_array;
}

=head2 pop_message

 my $message = $self->pop_message();
 my $message = $self->pop_message( -scope => 'mainpage' );
 my $message = $self->pop_message( -scope => 'mainpage', -classification =>
'WARNING' );
 my $message = $self->pop_message( -classification => 'ERROR' );

Pops off the last message from the stack and returns it.  Note that this
just returns the -message part.

You can pop off an exact message, given a hash parameters, using the same
keys as specified in the push_message() method.

Otherwise, it will pop off the message, given the current runmode and the
last message added.

=cut

sub pop_message {
    my $self = shift;
    my $session = _check_for_session( $self );
    my %limiting_params = @_;
    my $message;
    my $message_array = $session->param( '__CAP_MessageStack_Stack' );

    if ( $config{'-dont_use_session'} ) {
        $session->param( '__CAP_MessageStack_Stack' => undef );
    } else {
        $session->clear( [ '__CAP_MessageStack_Stack' ] );
    }

    if ( $limiting_params{'-scope'} || $limiting_params{'-classification'} )
{
        my $index = scalar( @$message_array ) - 1;
        foreach my $message_hashref ( reverse @$message_array ) {
            # now we're looking for the first matching element ... if/when
we find it,
            # set the $message and splice out the element from the
$message_array
            my $match_found = 0;

            if ( $limiting_params{'-scope'} &&
$limiting_params{'-classification'} ) {
                if ( ( ! $message_hashref->{'-scope'} || ( ( ref(
$message_hashref->{'-scope'} ) && grep { $_ eq $limiting_params{'-scope'} }
@{$message_hashref->{'-scope'}}  ) || ( ! ref ( $message_hashref->{'-scope'}
) && $message_hashref->{'-scope'} eq $limiting_params{'-scope'} ) ) ) && (
$message_hashref->{'-classification'} &&
$message_hashref->{'-classification'} eq $limiting_params{'-classification'}
) ) {
                    $match_found = 1;
                    $message = $message_hashref->{'-message'};
                }
            } elsif ( $limiting_params{'-scope'} ) {
                if ( ! $message_hashref->{'-scope'} ) {
                    $match_found = 1;
                    $message = $message_hashref->{'-message'};
                } else {
		    if ( ref( $message_hashref->{'-scope'} ) ) {
		        if ( grep { $_ eq $limiting_params{'-scope'} }
@{$message_hashref->{'-scope'}} ) {
			    $match_found = 1;
			    $message = $message_hashref->{'-message'};
			}
		    } else {
		        if ( $message_hashref->{'-scope'} eq
$limiting_params{'-scope'} ) {
			    $match_found = 1;
			    $message = $message_hashref->{'-message'};
			}
		    }
		}
            } elsif ( $limiting_params{'-classification'} ) {
                if ( $message_hashref->{'-classification'} &&
$message_hashref->{'-classification'} eq $limiting_params{'-classification'}
) {
                    $match_found = 1;
                    $message = $message_hashref->{'-message'};
                }
            }

            if ( $match_found ) {
                splice( @$message_array, $index, 1 );
                last;
            }

            $index--;
        }
    } else {
        my $message_hashref = pop @$message_array;
        $message = $message_hashref->{'-message'};
    }

    $session->param( '__CAP_MessageStack_Stack' => $message_array );

    $message;
}

=head2 clear_messages

 $self->clear_messages();
 $self->clear_messages( -scope => 'mainpage' );
 $self->clear_messages( -scope => 'mainpage', -classification => 'ERROR' );
 $self->clear_messages( -classification => 'ERROR' );

Clears the message stack.

Optionally, you can clear particular slices of the message stack, given a
hash parameters, using the same keys as specified in the push_message()
method.

If you specify a scope, it will clear any messages that are either global or
match that scope

If you specify a classification, it will clear any messages that have that
classification (but not any messages that don't have any classification).

If you specify both, it will combine both that logic in an AND fashion.

=cut

sub clear_messages {
    my $self = shift;
    my $session = _check_for_session( $self );
    my %limiting_params = @_;
    if ( $limiting_params{'-scope'} || $limiting_params{'-classification'} )
{
        my $message_array = $session->param( '__CAP_MessageStack_Stack' );
        # can't use filter, b/c we need to invert that result...
        my $nonmatching_messages = [];
        if ( $limiting_params{'-classification'} &&
$limiting_params{'-scope'} ) {
            foreach my $message_hashref ( @$message_array ) {
                next if ( $message_hashref->{'-classification'} &&
$message_hashref->{'-classification'} eq $limiting_params{'-classification'}
) && ( !$message_hashref->{'-scope'} || ( ( ref(
$message_hashref->{'-scope'} ) && grep { $_ eq $limiting_params{'-scope'} }
@{$message_hashref->{'-scope'}} ) || ( ! ref( $message_hashref->{'-scope'} )
&& $message_hashref->{'-scope'} eq $limiting_params{'-scope'} ) ) );
                push @$nonmatching_messages, $message_hashref;
            }
        } elsif ( $limiting_params{'-classification'} ) {
            foreach my $message_hashref ( @$message_array ) {
                next if $message_hashref->{'-classification'} &&
$message_hashref->{'-classification'} eq
$limiting_params{'-classification'};
                push @$nonmatching_messages, $message_hashref;
            }
        } elsif ( $limiting_params{'-scope'} ) {
            foreach my $message_hashref ( @$message_array ) {
                next if ! $message_hashref->{'-scope'}; # taking out global
scopes
		if ( ref( $message_hashref->{'-scope'} ) ) {
		    next if grep { $_ eq $limiting_params{'-scope'} }
@{$message_hashref->{'-scope'}};
		} else {
                    next if $message_hashref->{'-scope'} eq
$limiting_params{'-scope'}; # taking out matching scopes
		}
                push @$nonmatching_messages, $message_hashref;
            }
        }
        $session->param( '__CAP_MessageStack_Stack' => $nonmatching_messages
);
    } else {
        if ( $config{'-dont_use_session'} ) {
            $session->param( '__CAP_MessageStack_Stack' => undef );
        } else {
            $session->clear( [ '__CAP_MessageStack_Stack' ] );
        }
    }
}

=head2 capms_config

 $self->capms_config(
     -automatic_clearing            => 1,
     -dont_use_session              => 1,
     -loop_param_name               => 'MyOwnLoopName',
     -message_param_name            => 'MyOwnMessageName',
     -classification_param_name     => 'MyOwnClassificationName',
   );

There is a configuration option that you, as the developer can specify:

=over

=item * -automatic_clearing: By default, this is turned off.  If you
override it with a true value, it will call clear_messages() automatically
after the messages are automatically put into template.

=item * -dont_use_session: This will override this Plugin's dependence on
CGI::Application::Plugin::Session and instead, temporarily store the message
data such that it will be available to templates within the same web
request, but no further.  If you're running your cgiapp under a persistent
state (mod_perl), we'll also make sure your messages are gone by the end of
the request.

=item * -loop_param_name: This will override the default __CAP_Messages (or
CAP_Messages for TT users) name for the loop of messages, which is only used
for the C<load_tmpl> callback.  Meaning, this configuration will only impact
your template code.  So if you use the 'MyOwnLoopName' above, then your
template code (for HTML::Template users) should look like:

 <!-- TMPL_LOOP NAME="MyOwnLoopName" -->
 ...
 <!-- /TMPL_LOOP -->

=item * -message_param_name: This will override the default '-message' in
both the template code B<as well as> the keys in each hashref of the
arrayref that's returned by the messages() function.  So a call to
messages() may return:

 [ { 'MyOwnMessageName' => 'this is just a test' }, ... ]

instead of:

 [ { '-message' => 'this is just a test' }, ... ]

Likewise, your templates will need to use your parameter name:

 <!-- TMPL_LOOP NAME="MyOwnLoopName" -->
   Here's the message: <!-- TMPL_VAR NAME="MyOwnMessageName" -->
 <!-- /TMPL_LOOP -->

=item * -classification_param_name: Just like the C<-message_param_name>
parameter - this will override the default '-classification' key in both the
template code B<as well as> the keys in each hashref of the arrayref that's
returned by the messages() function.  So a call to messages() may return:

 [ { 'MyOwnClassificationName' => 'ERROR', 'MyOwnMessageName' => 'this is
just a test' }, ... ]

instead of:

 [ { '-classification' => 'ERROR', '-message' => 'this is just a test' },
... ]

Likewise, your templates will need to use your parameter name:

 <!-- TMPL_LOOP NAME="MyOwnLoopName" -->
    <div class="<!-- TMPL_VAR NAME="MyOwnClassificationName" -->">
       Here's the message: <!-- TMPL_VAR NAME="MyOwnMessageName" -->
    </div>
 <!-- /TMPL_LOOP -->

=back

=cut

sub capms_config {
    my $self = shift;
    %config = @_;
}

sub _filter_messages {
    my ( $messages, $limiting_params, $for_template ) = @_;

    my $matching_messages = [];
    my $class_key = $config{'-classification_param_name'} ||
'classification';
    my $message_key = $config{'-message_param_name'} || 'message';

    if ( $limiting_params->{'-classification'} &&
$limiting_params->{'-scope'} ) {
        foreach my $message_hashref ( @$messages ) {
            next if !$message_hashref->{'-classification'} ||
$message_hashref->{'-classification'} ne
$limiting_params->{'-classification'};
	    if ( ref( $message_hashref->{'-scope'} ) ) {
	        next if ! grep { $_ eq $limiting_params->{'-scope'} }
@{$message_hashref->{'-scope'}};
	    } else {
                next if $message_hashref->{'-scope'} &&
$message_hashref->{'-scope'} ne $limiting_params->{'-scope'};
            }
            # i'm beginning to hate the dash now ... now i have to take 'em
out
            # so the template code doesn't need/use 'em...
            if ( $for_template ) {
                push @$matching_messages, {
                        $class_key    =>
$message_hashref->{'-classification'},
                        $message_key  => $message_hashref->{'-message'},
                    };
            } else {
                push @$matching_messages, $message_hashref;
            }
        }
    } elsif ( $limiting_params->{'-classification'} ) {
        foreach my $message_hashref ( @$messages ) {
            next if !$message_hashref->{'-classification'} ||
$message_hashref->{'-classification'} ne
$limiting_params->{'-classification'};
            if ( $for_template ) {
                push @$matching_messages, {
                        $class_key      =>
$message_hashref->{'-classification'},
                        $message_key    => $message_hashref->{'-message'},
                    };
            } else {
                push @$matching_messages, $message_hashref;
            }
        }
    } elsif ( $limiting_params->{'-scope'} ) {
        foreach my $message_hashref ( @$messages ) {
	    if ( ref( $message_hashref->{'-scope'} ) ) {
	        next if ! grep { $_ eq $limiting_params->{'-scope'} }
@{$message_hashref->{'-scope'}};
	    } else {
                next if $message_hashref->{'-scope'} &&
$message_hashref->{'-scope'} ne $limiting_params->{'-scope'};
            }
            if ( $for_template ) {
                push @$matching_messages, {
                        $class_key    =>
$message_hashref->{'-classification'},
                        $message_key  => $message_hashref->{'-message'},
                    };
            } else {
                push @$matching_messages, $message_hashref;
            }
        }
    }

    return $matching_messages;
}

sub _pass_in_messages {
    my ( $self, $ht_params, $tmpl_params, $tmpl_file ) = @_;

    # get the proper messages and update $tmpl_params
    my $session = _check_for_session( $self );
    my $current_runmode = $self->get_current_runmode();
    my $message_stack = $session->param( '__CAP_MessageStack_Stack' );
    my $messages = _filter_messages( $message_stack, { -scope =>
$current_runmode }, 1 );
    my $loop_name = $config{'-loop_param_name'} || 'CAP_Messages';

	# -- check for HTML::Template and die_on_bad_params => 1
    if( (!exists $ht_params->{die_on_bad_params} or
$ht_params->{die_on_bad_params} = 1)
	   and $self->html_tmpl_class() eq 'HTML::Template' and scalar(
@$messages ) > 0 ) {
	
        my $t = undef;
        # -- copied from CGI::Application::load_tmpl()
        if( ref $tmpl_file eq 'SCALAR' ) {
            $t = HTML::Template->new( scalarref => $tmpl_file, %{$ht_params}
);
        } elsif ( ref $tmpl_file eq 'GLOB' ) {
            $t = HTML::Template->new( filehandle => $tmpl_file,
%{$ht_params} );
        } else {
            $t = HTML::Template->new( filename => $tmpl_file,
%{$ht_params});
        }
		
		if( $t->query(name => $loop_name) ) {
			$tmpl_params->{ $loop_name } = $messages if scalar(
@$messages );
			$self->clear_messages( -scope => $current_runmode )
if ( $config{'-automatic_clearing'} );
			# -- im'm not sure, but would it make sende to do:
			$tmpl_file = \$t->output(); # ?
		}

    }else{
		# -- pass in anyways
		$tmpl_params->{ $loop_name } = $messages if scalar(
@$messages );
		$self->clear_messages( -scope => $current_runmode ) if (
$config{'-automatic_clearing'} );
	}

}

# This method will return an object, depending on if the developer wants to
# use a session (the default behavior) or just the cgiapp itself.
sub _check_for_session {
    my $self = shift;
    my $session_object = undef;

    if ( $config{'-dont_use_session'} ) {
        $session_object = $self;
    } else {
        # dynamic importing of CAP-Session
        eval {
            require CGI::Application::Plugin::Session;
            CGI::Application::Plugin::Session->import();
            $session_object = $self->session;
        };
        if ( $@ || ! $session_object ) {
            die "No session object!  This module depends on
CGI::Application::Plugin::Session! (or you need to use the -dont_use_session
config parameter)"
        }
    }
    return $session_object;
}

=head1 AUTHOR

Jason Purdy, C<< <Jason at Purdy.INFO> >>

=head1 SEE ALSO

L<CGI::Application> and L<CGI::Application::Plugin::Session>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-cgi-application-plugin-messagestack at rt.cpan.org>, or through the web
interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-Plugin-Mess
ageStack>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

I suspect that this code could use some expert guidance.  I hacked it
together and I'd hate to think that it would be responsible for slowing
templates down.  Please feel free to submit patches, guiding comments, etc.

=head1 ACKNOWLEDGEMENTS

Thanks to the guys on the #cgiapp channel

=head1 COPYRIGHT & LICENSE

Copyright 2005 Jason Purdy, all rights reserved.

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

=cut

1; # End of CGI::Application::Plugin::MessageStack

__END__
[/code]




****************************************************************************
*********
./run2.cgi
[code]
#!/Perl/bin/perl

package CatcherInTheRye;

use strict;
use warnings;
use base qw/CGI::Application/;
use CGI::Application::Plugin::Forward;
use CGI::Application::Plugin::Redirect;
use CGI::Application::Plugin::Session;
use CGI::Application::Plugin::MessageStack;

use Benchmark qw(:all);
use Data::Dumper qw/Dumper/;

=head1 NAME

CatcherInTheRye - a boring book


=head1 DESCRIPTION

This script demonstrates the bugfix for CAP::MessageStack in conjunction
with
HTML::Template and die_on_bad_params => 1.

Usually, capms would try to set the CAP_MessageStack TMPL_LOOP regardless if
it is defined in a template. HTML::Template would die if this TMPL_LOOP is
not
defined when die_on_bad_params set to 1 (which is default and useful).

The bugfix introduces a check for the case that HTML::Template is used (no
check is done when anything else than HT is used) to avoid the problem
mentioned.

The check ist performed this way: if HTML::Template is used, the template
gets
instantiated during the check and query()ied for the CAP_MessageStack param.
Unless present, no param will be set by CAP::MessageStack.

=head1 METHODS

=cut

=head2 setup()

Defined runmodes, etc.

=cut

sub setup {
	my $self = shift;
	
	$self->start_mode('start');
	$self->run_modes([qw/
		start
		add_message
		timing
	/]);
	
} # /setup




=head2 start()

Display a form to push a message and all messages pushed.

=cut

sub start {
	my $self 	= shift;
	
	my $html = q~
<!-- TMPL_LOOP NAME="CAP_Messages" -->
	<div class="<!-- TMPL_VAR NAME="classification" -->">
	<!-- TMPL_VAR NAME="message" -->
	</div>
<!-- /TMPL_LOOP -->

<form action="run2.cgi">
	<input type="hidden" name="rm" value="add_message" />
	<input type="submit" value="add random message" />
</form>
	~;
	
	
	my $t = $self->load_tmpl(\$html);
	return $t->output();
} # /start




=head2 add_message()

Pushes a random message to the message stack.

=cut

sub add_message {
	my $self = shift;
	
	my $random = 4; # see http://xkcd.com/221/
	$self->push_message(
		-scope          => 'start',
		-message        => $random,
		-classification => 'INFO',
	);
	
	return $self->forward( 'start' );
} # /add_message




=head2 timing()

Test timings. Feel free to use some more complex template files.

=cut

sub timing {
	my $self = shift;

	my $html = q~
<!-- TMPL_LOOP NAME="CAP_Messages" -->
	<div class="<!-- TMPL_VAR NAME="classification" -->">
	<!-- TMPL_VAR NAME="message" -->
	</div>
<!-- /TMPL_LOOP -->

<form action="run.cgi">
	<input type="hidden" name="rm" value="add_message" />
	<input type="submit" value="add random message" />
</form>
	~;

    # Use Perl code in strings...
	my $count = 100;
    my $results = timethese($count, {
        'with_check' => sub{ my $t = $self->load_tmpl(\$html); },
    });
	
	return Dumper $results;
} # /timing




=head2 cgiapp_postrun( $output )

Output manipulation:

Surround content with a template that does not contain the capms
message_loop
TMPL_LOOP. Without the fix, this would cause the script to crash when
die_on_bad_params => 1.

=cut

sub cgiapp_postrun {
	my $self = shift;
	my $output = shift;

# this will not work with the unpatched version of CAP::MessageStack
#	my $layout_without_capms_loop = q~
#<html>
#<body>
#	<h1>Border template without CAP::MessageStack TMPL_LOOP</h1>
#	<TMPL_VAR main_content>
#	<hr />
#	CGI::Application::Plugin::MessageStack::VERSION = <TMPL_VAR
cap_messagestack_version>
#</body>
#</html>
#	~;
#	
#	my $layout = $self->load_tmpl(\$layout_without_capms_loop);
#	
#	# -- fill in content
#	$layout->param('main_content' => $$output);
#	$layout->param('cap_messagestack_version' =>
$CGI::Application::Plugin::MessageStack::VERSION);
#	
#	$$output = $layout->output();

} # /cgiapp_postrun




=head1 AUTHOR

Alex, E<lt>c a p f a n < a t > g m x . d eE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by Alexander Becker

This library is free software; you can redistribute it and/or modify it
under
the same terms as Perl itself, either Perl version 5.8.8 or, at your option,
any later version of Perl 5 you may have available.

=cut

1;


use strict;
use warnings;
use FindBin qw/$Bin/;
use lib $Bin . '/lib';

my $app = CatcherInTheRye->new();
$app->run();
[/code]




****************************************************************************
*********
./run.cgi
[code]
#!/Perl/bin/perl

package CatcherInTheRye;

use strict;
use warnings;
use base qw/CGI::Application/;

use FindBin qw/$Bin/;
use lib $Bin . '/lib';

use CGI::Application::Plugin::Forward;
use CGI::Application::Plugin::Redirect;
use CGI::Application::Plugin::Session;
use CGI::Application::Plugin::MessageStack;
use Benchmark qw(:all);
use Data::Dumper qw/Dumper/;

=head1 NAME

CatcherInTheRye - a boring book


=head1 DESCRIPTION

This script demonstrates the bugfix for CAP::MessageStack in conjunction
with
HTML::Template and die_on_bad_params => 1.

Usually, capms would try to set the CAP_MessageStack TMPL_LOOP regardless if
it is defined in a template. HTML::Template would die if this TMPL_LOOP is
not
defined when die_on_bad_params set to 1 (which is default and useful).

The bugfix introduces a check for the case that HTML::Template is used (no
check is done when anything else than HT is used) to avoid the problem
mentioned.

The check ist performed this way: if HTML::Template is used, the template
gets
instantiated during the check and query()ied for the CAP_MessageStack param.
Unless present, no param will be set by CAP::MessageStack.

=head1 METHODS

=cut

=head2 setup()

Defined runmodes, etc.

=cut

sub setup {
	my $self = shift;
	
	$self->start_mode('start');
	$self->run_modes([qw/
		start
		add_message
		timing
	/]);
	
} # /setup




=head2 start()

Display a form to push a message and all messages pushed.

=cut

sub start {
	my $self 	= shift;
	
	my $html = q~
<!-- TMPL_LOOP NAME="CAP_Messages" -->
	<div class="<!-- TMPL_VAR NAME="classification" -->">
	<!-- TMPL_VAR NAME="message" -->
	</div>
<!-- /TMPL_LOOP -->

<form action="run.cgi">
	<input type="hidden" name="rm" value="add_message" />
	<input type="submit" value="add random message" />
</form>
	~;
	
	my $t = $self->load_tmpl(\$html, die_on_bad_params => 0,);
	return $t->output();
} # /start




=head2 add_message()

Pushes a random message to the message stack.

=cut

sub add_message {
	my $self = shift;
	
	my $random = 4; # see http://xkcd.com/221/
	$self->push_message(
		-scope          => 'start',
		-message        => $random,
		-classification => 'INFO',
	);
	
	return $self->forward( 'start' );
} # /add_message




=head2 timing()

=cut

sub timing {
	my $self = shift;

	my $html = q~
<!-- TMPL_LOOP NAME="CAP_Messages" -->
	<div class="<!-- TMPL_VAR NAME="classification" -->">
	<!-- TMPL_VAR NAME="message" -->
	</div>
<!-- /TMPL_LOOP -->

<form action="run.cgi">
	<input type="hidden" name="rm" value="add_message" />
	<input type="submit" value="add random message" />
</form>
	~;

    # Use Perl code in strings...
	my $count = 100;
    my $results = timethese($count, {
        'with_check' => sub{ my $t = $self->load_tmpl(\$html); },
    });
	
	return Dumper $results;
} # /timing




=head2 cgiapp_postrun( $output )

Output manipulation:

Surround content with a template that does not contain the capms
message_loop
TMPL_LOOP. Without the fix, this would cause the script to crash when
die_on_bad_params => 1.

=cut

sub cgiapp_postrun {
	my $self = shift;
	my $output = shift;
	
	my $layout_without_capms_loop = q~
<html>
<body>
	<h1>Border template without CAP::MessageStack TMPL_LOOP</h1>
	<TMPL_VAR main_content>
	<hr />
	CGI::Application::Plugin::MessageStack::VERSION = <TMPL_VAR
cap_messagestack_version>
</body>
</html>
	~;
	
	my $layout = $self->load_tmpl(\$layout_without_capms_loop);
	
	# -- fill in content
	$layout->param('main_content' => $$output);
	$layout->param('cap_messagestack_version' =>
$CGI::Application::Plugin::MessageStack::VERSION);
	
	$$output = $layout->output();

} # /cgiapp_postrun




=head1 AUTHOR

Alex, E<lt>c a p f a n < a t > g m x . d eE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by Alexander Becker

This library is free software; you can redistribute it and/or modify it
under
the same terms as Perl itself, either Perl version 5.8.8 or, at your option,
any later version of Perl 5 you may have available.

=cut

1;


use strict;
use warnings;
use FindBin qw/$Bin/;
use lib $Bin . '/lib';

my $app = CatcherInTheRye->new();
$app->run();
[/code]

HTH, Alex

-----Ursprüngliche Nachricht-----
Von: cgiapp-bounces at lists.openlib.org
[mailto:cgiapp-bounces at lists.openlib.org] Im Auftrag von Jason Purdy
Gesendet: Montag, 12. Oktober 2009 15:57
An: CGI Application
Betreff: Re: [cgiapp] [patch] CAP::MessageStack + CAP::FormState

Rumors of CAP::MessageStack death are greatly exaggerated. ;)

I apologize for the lack of a response and I wanted to apologize publicly. I
actually owe David Steinbrunner an even bigger apology for sitting on his
work for close to 2 years. I admit I'm a bad CPAN author and fall victim to
the "if it ain't broke, don't fix it" mindframe. I know when I submit bugs &
patches, I expect action soon-after. So I admit it's hypocritical of me and
again, I'm sorry.

I took a look at your problem & patch and in my opinion, there's room for
discussion on its merits. That's another reason I'm replying
publicly: to get others' thoughts.

First, the problem. It's something that's disclaimed in the documentation
and examples. It's not really a bug as I see it, versus its intended result.
If you're bringing in a plugin, you should accommodate its behavior, which
with MessageStack, you can do easily by overriding the die_on_bad_params or
putting the variables in your templates. I fall victim to the "bug" myself
from time-to-time, but I use CGI::Carp's fatalsToBrowser and it let's me
know what's wrong and I fix it.

Second, your patch isn't efficient and it's not complete. You're loading the
template to inspect its structure, which will add a second template loading
process and without the "TODO" code to check if die_on_bad_params is 0, this
will happen everytime. Granted, that TODO code is pretty easy to work out,
but that needs to be done and I'm interested in a more efficient solution.

CAP::TT has a neat method that I don't fully understand yet with new_hook
and call_hook. Perhaps that might be the way to go. Ideally, we could change
_pass_in_messages from being called before the template is loaded to
afterwards, when we can inspect the template structure.

- Jason

Alex wrote:
> Hi all!
> 
> Are CGI::Application::Plugin::MessageStack and FormState dead? Will 
> the lack of maintenance force users to abandon it and use other 
> modules? Will this force ppl to code the same functionality over and 
> over again - in contradiction of the idea of a flexible framework?

[snip]

#####  CGI::Application community mailing list  ################
##                                                            ##
##  To unsubscribe, or change your message delivery options,  ##
##  visit:  http://lists.openlib.org/mailman/listinfo/cgiapp    ##
##                                                            ##
##  Web archive:   http://lists.openlib.org/pipermail/cgiapp/   ##
##  Wiki:          http://cgiapp.erlbaum.net/                 ##
##                                                            ##
################################################################



More information about the cgiapp mailing list