Ambrosia

 view release on metacpan or  search on metacpan

benchmark/Ambrosia/CommonGatewayInterface.b  view on Meta::CPAN

}

sub setEnv
{
    my $action = shift;
    my $query_string = shift;
    $ENV{REQUEST_METHOD} = 'GET';

#generation
    $ENV{DOCUMENT_ROOT} = '/opt/debug.kuritsyn/web/cgi-coll/GOOGLE_COUPON/GoogleCoupon/htdocs';
    $ENV{HTTP_HOST} = 'vh-test-devbillingcoll.domain:8033';
    $ENV{SCRIPT_FILENAME} = '/opt/debug.kuritsyn/web/cgi-coll/GOOGLE_COUPON/GoogleCoupon/htdocs/GoogleCoupon';
    $ENV{SERVER_NAME} = 'vh-test-devbillingcoll.domain';
    $ENV{SERVER_PORT} = '8033';
    $ENV{SERVER_ADDR} = '192.168.14.223';
    $ENV{SCRIPT_NAME} = '/GoogleCoupon';

#parametrize
    $ENV{HTTP_COOKIE} = 'authorize_GOOGLECOUPON=%5EStorable%7C%7C%7Chex%7CCompress%3A%3AZlib%5E789c6365179472cc4d2aca2fce4cb4b20a2dc9cc29b6b272cecf2b49cccc4b2d62626060606201910c2ccc4082118964e2e23534f24c0ad24bf7b2284f2e48060a711424161797e717a570311b1...
    $ENV{PATH_INFO} = $action;
    $ENV{QUERY_STRING} = $query_string || '';

lib/Ambrosia/Assert.pm  view on Meta::CPAN

sub import
{
    my $package = shift;
    return if eval{$package->can('assert')};

    assign(shift) if @_;

    no strict 'refs';
    my $package_instance = caller(0);
    if ( debug_mode($PROCESS_MAP{$$}, @_) )
    {
        *{"${package_instance}::assert"} = sub(&$) { goto &__assert; };
    }
    else
    {
        *{"${package_instance}::assert"} = sub(&$) {};
    }

}

lib/Ambrosia/Assert.pm  view on Meta::CPAN

        exit(42);
    }
}
################################################################################

sub assign
{
    $PROCESS_MAP{$$} = shift;
}

sub debug_mode
{
    my $key = shift or return 0;
    my $mode = shift;

    unless(defined $ASSERT{$key})
    {
        throw Ambrosia::error::Exception::BadParams 'First usage Ambrosia::Assert without initialize.' unless defined $mode;
        $ASSERT{$key} = lc($mode) eq 'debug';
    }
    return $ASSERT{$key};
}

1;

#########
# MUST WRITE IN MAIN
#########
#END

lib/Ambrosia/Assert.pm  view on Meta::CPAN

Ambrosia::Assert - adds a validation method in your module.

=head1 VERSION

version 0.010

=head1 SYNOPSIS

    #foo.pm 
    use Ambrosia::Assert GLOBAL_KEY => 'debug';

    sub foo
    {
        my @params = @_;
        assert(sub {@params && $params[0] eq 'abc'}, 'invalid params in foo()');
        .......
    }

    #script.pl
    use foo;
    foo::foo();
    END
    {
        $? = 0 if $?==42;
    }

=head1 DESCRIPTION

C<Ambrosia::Assert> adds a validation method in your module.
You can on or off assert for debug.

=head1 USAGE

    use Ambrosia::Assert GLOBAL_KEY => 'debug'; #on validation
    use Ambrosia::Assert GLOBAL_KEY => 'nodebug'; #off validation

GLOBAL_KEY is any keyword, for example application name.

=head1 METHODS

=head2 assert( $subroutine, $message )

    assert(sub {@params && $params[0] eq 'abc'}, 'invalid params in foo()');

If the $subroutine returns false then application execution will be stopped.

lib/Ambrosia/Logger.pm  view on Meta::CPAN

        {
            *{"${pkg}::log_info_ex"} = sub { goto &__info_ex; };
        }
        else
        {
            *{"${pkg}::log_info_ex"} = sub { goto *{"${pkg}::log_info"}; };
        }

        if ( $params{DEBUG} )
        {
            *{"${pkg}::log_debug"} = sub { goto &__debug; };
        }
        else
        {
            *{"${pkg}::log_debug"} = sub { goto *{"${pkg}::log_info_ex"}; };
        }

        if ( $params{TIME} )
        {
            *{"${pkg}::log_time"} = sub { goto &__log_time; };
        }
        else
        {
            *{"${pkg}::log_time"} = sub {};
        }

lib/Ambrosia/Logger.pm  view on Meta::CPAN

        }
        else
        {
            $self->log( $msg, " -::- vvvvvvvvvvvvvvvvvvv $key" );
        }
    }
    $self->{_time}->{$key} = time if $key;
}


sub __debug
{
    my ($self, @msg) = @_;
    my $p = __PACKAGE__;
    my $x = 0;
    my ($package, $line, $subroutine);
    my @callers;
 
    while ( do { package DB; ($package, $line, $subroutine) = (caller($x++))[0, 2, 3] } )
    {
        my @arg = $subroutine !~ /^$p\:\:/ ? @DB::args : ('...');

lib/Ambrosia/Logger.pm  view on Meta::CPAN

    use Ambrosia::Logger;
    BEGIN {
        instance Ambrosia::Logger('myApplication', DEBUG => 1, INFO_EX => 1, INFO => 1, -prefix => 'GoogleCoupon_', -dir => $logger_path);
        Ambrosia::Logger::assign 'myApplication';
    }

    logger->log('is just message', 'other message' );
    logger->log_info('is simple info', ... );
    logger->log_info_ex('is dump of structures info', {foo=>1}, [{bar=>1},{baz=>2}] );
    logger->error('message about errors');
    logger->debug('write with the message and the stack of calls');

=head1 DESCRIPTION

C<Ambrosia::Logger> is a class for create global object for logging.
Implement the pattern B<Singleton>.

=head2 instance

Instances the named object of type C<Ambrosia::Logger> in the pool.
This method not exported. Use as constructor: C<instance Ambrosia::Logger(.....)>

share/Templates/Common/HandlerModule.xsl  view on Meta::CPAN

    my $viewXML  = new Ambrosia::View::XSLT( charset => config->Charset, rootName => '<xsl:value-of select="$UcAppName" />' );
    my $viewJSON = new Ambrosia::View::JSON( charset => config->Charset );

    $dispatcher = Ambrosia::Dispatcher
        ->new()
<xsl:if test="/atns:Application/@Authorization!='NO'">
        ->on_check_access(\&amp;check_access)
</xsl:if>
        ->on_error(sub { error($_[1]) })
        ->on_complete(sub {
                Context->repository->set( __debug => config->DEBUG );
                if ( my $mng = shift )
                {
                    if( Context->response_type eq 'xml' )
                    {
                        Context->print_response_header(
                                -Content_type => 'application/xml',
                                -Charset      => config->Charset,
                                -cookie       => session->getSessionValue,
                            );
                        print scalar $viewXML->as_xml();

t/Ambrosia/Assert.t  view on Meta::CPAN

#!/usr/bin/perl

{
    package test1;
    use lib qw(lib t ..);
    use Ambrosia::Assert test1 => 'nodebug';

    our $val = 0;

    sub sucess1
    {
        assert(sub {$val < 2}, 'valid condition');
        return 1;
    }

    sub sucess2
    {
        assert(sub {$val > 2}, 'invalid condition');
        return 1;
    }
}

{
    package test2;
    use lib qw(lib t ..);
    use Ambrosia::Assert test2 => 'debug';

    our $val = 0;

    sub sucess1
    {
        assert(sub {$val < 2}, 'valid condition');
        return 1;
    }

    sub sucess2