validate results from the CPAN

Ambrosia
        do
        {
            Context->start_session();
            $dispatcher->run(Context->action);
            Context->finish_session;
        } while (!Context->is_complete);
    };

    if ($@)
    {
        error($@);
    }
}

sub error
{
    my $errmsg = shift || 'Internal error.';
    logger->error("$errmsg");
    $errmsg = config->DEBUG ? "$errmsg" : "An error occurred during program execution.\n";

    storage->foreach('cancel_transaction');
    storage->foreach('close_connection');

    Context->print_response_header(
            -Content_type => 'text/html',
            -Charset      => config->Charset,
            -cookie       => session->getSessionValue,
        );

    $errmsg =~ s{\n}{}g;
    my $charset = config->Charset;
    print &lt;&lt;EOB;
<HTML>
<HEAD><TITLE>Error!</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=$charset" />
</HEAD>
<BODY>
<SPAN style="padding:30px;"><B><FONT color="red" size="+2"><BR/><BR/>$errmsg</FONT></B></SPAN>
</BODY>
</HTML>
EOB

    Context->abort_session();
}

<xsl:if test="/atns:Application/@Authorization!='NO'">
sub check_access
{
    my $mng = shift;
    my $val = session()->getItem(<xsl:value-of select="$RealAppName" />::Accessor::get_access_key_name()) || {};
    my $result = accessor()->authenticate(
            Context->param('login')
                ? (Context->param('login'), Context->param('password'))
                : ($val->{login}, $val->{password}),
            $mng->{access}
        );

    if ( $result->IS_REDIRECT )
    {
        Context->redirect(
                -must_revalidate  => 1,
                -max_age  => 0,
                -no_cache => 1,
                -no_store => 1,
                -charset  => config->Charset,
                -uri      => (Context->proxy || Context->full_script_path) . $ENV{PATH_INFO},
                session->hasSessionData() ? (-cookie   => session->getSessionValue()) : (),
            );
        return 0;
    }

    controller->reset('/authorize') unless $result->IS_PERMIT;

    return 1;
}
</xsl:if>

1;
</xsl:template>

</xsl:stylesheet>
( run in 0.541 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )