Amon2

 view release on metacpan or  search on metacpan

lib/Amon2.pm  view on Meta::CPAN

    sub context { $CONTEXT }
    sub set_context { $CONTEXT = $_[1] }
    sub context_guard {
        Amon2::ContextGuard->new($_[0], \$CONTEXT);
    }
}

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{ $_[0] } : @_;
    bless { %args }, $class;
}

# For CLI.
sub bootstrap {
    my $class = shift;
    my $self = $class->new(@_);
    $class->set_context($self);
    return $self;
}

lib/Amon2/ContextGuard.pm  view on Meta::CPAN

# THIS IS INTERNAL CLASS.
# DO NOT USE THIS CLASS DIRECTLY.
use strict;
use warnings;
use utf8;

sub new {
    my ($class, $context, $dst) = @_;
    my $orig = $$dst;
    $$dst = $context;
    bless [$orig, $dst], $class;
}

sub DESTROY {
    my $self = shift;

    # paranoia: guard against cyclic reference
    delete ${$self->[1]}->{$_} for keys %{${$self->[1]}};

    ${$self->[1]} = $self->[0];
}

lib/Amon2/Plugin/Web/Streaming.pm  view on Meta::CPAN

            );
            $code->($longpoll_ctx);
        }
    );
}

package Amon2::Plugin::Web::Streaming::Writer;

sub new {
    my ($class, $c, $writer) = @_;
    bless {ctx => $c, writer => $writer}, $class;
}

sub write_json {
    my ($self, $data) = @_;
    my $json = $self->{ctx}->render_json($data)->content;
    $self->{writer}->write($json);
}

sub close {
    my ($self) = @_;

lib/Amon2/Setup/Flavor.pm  view on Meta::CPAN

        die "Missing mandatory parameter $_" unless exists $args{$_};
    }
    $args{module} =~ s!-!::!g;

    # $module = "Foo::Bar"
    # $dist   = "Foo-Bar"
    # $path   = "Foo/Bar"
    my @pkg  = split /::/, $args{module};
    $args{dist} = join "-", @pkg;
    $args{path} = join "/", @pkg;
    my $self = bless { %args }, $class;
    $self->{xslate} = $self->_build_xslate();
    $self->load_assets();
    $self;
}

sub _build_xslate {
    my $self = shift;

    my $xslate = Text::Xslate->new(
        syntax => 'Kolon',

lib/Amon2/Setup/VC/Git.pm  view on Meta::CPAN

package Amon2::Setup::VC::Git;
use strict;
use warnings;
use utf8;
use File::Temp qw(tempfile);

sub new {
    bless {}, $_[0];
}

sub do_import {
    my ($self) = @_;

    unless ($self->_is_git_available('git')) {
        warn "There is no git command.\n";
        return;
    }

lib/Amon2/Trigger.pm  view on Meta::CPAN

    my ($class, $hook, @args) = @_;
    my @code = $class->get_trigger_code($hook);
    for my $code (@code) {
        $code->($class, @args);
    }
}

sub get_trigger_code {
    my ($class, $hook) = @_;
    my @code;
    if (Scalar::Util::blessed($class)) {
        push @code, @{ $class->{_trigger}->{$hook} || [] };
        $class = ref $class;
    }
    no strict 'refs';
    my $klass = ref $class || $class;
    for (@{mro::get_linear_isa($class)}) {
        push @code, @{${"${_}::_trigger"}->{$hook} || []};
    }
    return @code;
}

lib/Amon2/Web.pm  view on Meta::CPAN

    my $req = $class->create_request($env);
    my $self = $class->new(
        request => $req,
    );
    my $guard = $self->context_guard();

    my $response;
    for my $code ($self->get_trigger_code('BEFORE_DISPATCH')) {
        $response = $code->($self);
        goto PROCESS_END if Scalar::Util::blessed($response) && $response->isa('Plack::Response');
    }
    $response = $self->dispatch() or die "cannot get any response";
PROCESS_END:
    $self->call_trigger('AFTER_DISPATCH' => $response);

    return $response->finalize;
}

sub uri_for {
    my ($self, $path, $query) = @_;

lib/Amon2/Web/Response/Callback.pm  view on Meta::CPAN

use strict;
use warnings;
use utf8;
use Carp ();
use HTTP::Headers ();

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    $args{code} || Carp::croak "Missing mandatory parameter: code";
    bless {
        headers => HTTP::Headers->new,
        %args
    }, $class;
}
sub header {
    my $self = shift;
    $self->headers->header(@_);
}
sub headers { $_[0]->{headers} }
sub finalize {

lib/Amon2/Web/WebSocket.pm  view on Meta::CPAN

package Amon2::Web::WebSocket;
use strict;
use warnings;
use utf8;

sub new {
    my $class = shift;
    my %args = @_==1 ? %{$_[0]} : @_;
    bless {
        %args
    }, $class;
}

sub on_receive_message {
    my ( $self, $code ) = @_;
    $self->{on_receive_message} = $code;
}

sub on_error {

t/100_core/004_web_to_app_leak.t  view on Meta::CPAN

use strict;
use warnings;
use utf8;
use Test::More;

our $DESTROY = 0;
our $DISPATCH = 0;

{
    package MockDB;
    sub new { bless {}, shift }
    sub DESTROY { $::DESTROY++ }
}

{
    package MyApp::Web;
    use parent qw/Amon2 Amon2::Web/;
    sub dispatch {
        my ($c) = @_;
        return $c->create_response(200, [], 'dispatch OK');
    }

t/100_core/005_trigger.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;

{
    package MyApp;
    use Amon2::Trigger;

    sub new { bless { BAR => 0 }, shift }

    __PACKAGE__->add_trigger(
        FOO => sub {
            my $self = shift;
            $self->{FOO} = 1;
        },
        BAR => sub {
            my $self = shift;
            $self->{BAR} += 1;
        },

t/100_core/005_trigger.t  view on Meta::CPAN

    is $app->{BAR}, 2;
    is $app->{BAZ}, 1;
};

# -------------------------------------------------------------------------

{
    package MyApp::Parent;
    use Amon2::Trigger;

    sub new { bless { BAR => 0 }, shift }
    __PACKAGE__->add_trigger(
        f => sub { $_[0]->{p}++ }
    );

    package MyApp::Child;
    our @ISA = qw/MyApp::Parent/;

    __PACKAGE__->add_trigger(
        f => sub { $_[0]->{c}++ }
    );

t/100_core/012_trigger_controller.t  view on Meta::CPAN

use strict;
use warnings;
use utf8;
use Test::More;

{
    package MyApp::V1;
    use parent qw/Amon2 Amon2::Web/;
    __PACKAGE__->add_trigger(
        BEFORE_DISPATCH => sub { 1 } # returns unblessed value
    );
    sub dispatch { Amon2::Web::Response->new(200, [], ['OK']) }
}

is(MyApp::V1->to_app->({})->[2]->[0], 'OK');

{
    package MyApp::V2;
    use parent qw/Amon2 Amon2::Web/;
    __PACKAGE__->add_trigger(

t/100_core/016_context_guard.t  view on Meta::CPAN

use warnings;
use utf8;
use Test::More;


subtest 'unit test' => sub {
{
    package C;
    sub new {
        my $class = shift;
        bless {@_}, $class;
    }
    sub DEMOLISH { }
    sub x { shift->{x} }
}
    my $x = C->new(x => 3);
    my $guard = Amon2::ContextGuard->new(C->new(x => 4), \$x);
    is($x->x, 4);
    undef $guard;
    is($x->x, 3);
};