sub\s results from the CPAN

APNS-Agent

view release on metacpan or search on metacpan


    
);
if (-d 'share') {
    $args{share_dir} = 'share';
}

my $builder = Module::Build->subclass(
    class => 'MyBuilder',
    code => q{
        sub ACTION_distmeta {
            die "Do not run distmeta. Install Minilla and `minil install` instead.\n";
        }
        sub ACTION_installdeps {
            die "Do not run installdeps. Run `cpanm --installdeps .` instead.\n";
        }
    }
)->new(%args);
$builder->create_build_script();

my $mbmeta = CPAN::Meta->load_file('MYMETA.json');
my $meta = CPAN::Meta->load_file('META.json');
my $prereqs_hash = CPAN::Meta::Prereqs->new(
    $meta->prereqs

cpanfile view on Meta::CPAN

requires 'Encode';
requires 'Hash::Rename';
requires 'JSON::XS';
requires 'Log::Minimal';
requires 'Plack::Loader';
requires 'Plack::Request';
requires 'Router::Boom::Method';
requires 'feature';
requires 'perl', '5.010_000';

on configure => sub {
    requires 'CPAN::Meta';
    requires 'CPAN::Meta::Prereqs';
    requires 'Module::Build';
};

on test => sub {
    requires 'AnyEvent';
    requires 'AnyEvent::Socket';
    requires 'HTTP::Request::Common';
    requires 'Plack::Test';
    requires 'Test::More', '0.98';
    requires 'Test::TCP';
};

lib/APNS/Agent.pm view on Meta::CPAN


use Class::Accessor::Lite::Lazy 0.03 (
    new => 1,
    ro => [qw/
        certificate
        private_key
        sandbox
        debug_port
    /],
    ro_lazy => {
        on_error_response   => sub {
            sub {
                my $self = shift;
                my %d = %{$_[0]};
                warnf "identifier:%s\tstate:%s\ttoken:%s", $d{identifier}, $d{state}, $d{token} || '';
            }
        },
        disconnect_interval => sub { 60 },
        send_interval       => sub { 0.01 },
        _sent_cache         => sub { Cache::LRU->new(size => 10000) },
        _queue              => sub { [] },
        __apns              => '_build_apns',
        _sent               => sub { 0 },
    },
    rw => [qw/_last_sent_at _disconnect_timer/],
);

sub to_app {
    my $self = shift;

    my $router = Router::Boom::Method->new;
    $router->add(POST => '/'        => '_do_main');
    $router->add(GET  => '/monitor' => '_do_monitor');

    sub {
        my $env = shift;
        my ($target_method) = $router->match(@$env{qw/REQUEST_METHOD PATH_INFO/});

        return [404, [], ['NOT FOUND']] unless $target_method;

        my $req = Plack::Request->new($env);
        $self->$target_method($req);
    };
}

sub _do_main {
    my ($self, $req) = @_;

    my $token = $req->param('token') or return [400, [], ['Bad Request']];

    my $payload;
    if (my $payload_json = $req->param('payload') ) {
        state $json_driver = JSON::XS->new->utf8;
        local $@;
        $payload = eval { $json_driver->decode($payload_json) };
        return [400, [], ['BAD REQUEST']] if $@;

lib/APNS/Agent.pm view on Meta::CPAN

    infof "event:payload queued\ttoken:%s", $token;
    if ($self->__apns->connected) {
        $self->_sending;
    }
    else {
        $self->_connect_to_apns;
    }
    return [200, [], ['Accepted']];
}

sub _do_monitor {
    my ($self, $req) = @_;

    my $result = {
        sent   => $self->_sent,
        queued => scalar( @{ $self->_queue } ),
    };
    my $body = encode_json($result);

    return [200, [
        'Content-Type'   => 'application/json; charset=utf-8',
        'Content-Length' => length($body),
    ], [$body]];
}

sub _build_apns {
    my $self = shift;

    AnyEvent::APNS->new(
        certificate => $self->certificate,
        private_key => $self->private_key,
        sandbox     => $self->sandbox,
        on_error    => sub {
            my ($handle, $fatal, $message) = @_;

            my $t; $t = AnyEvent->timer(
                after    => 0,
                interval => 10,
                cb       => sub {
                    undef $t;
                    infof "event:reconnect";
                    $self->_connect_to_apns;
                },
            );
            warnf "event:error\tfatal:$fatal\tmessage:$message";
        },
        on_connect  => sub {
            infof "event:on_connect";
            $self->_disconnect_timer($self->_build_disconnect_timer);

            if (@{$self->_queue}) {
                $self->_sending;
            }
        },
        on_error_response => sub {
            my ($identifier, $state) = @_;
            my $data = $self->_sent_cache->get($identifier) || {};
            $self->on_error_response->($self, {
                identifier => $identifier,
                state      => $state,
                token      => $data->{token},
                payload    => $data->{payload},
            });
        },
        ($self->debug_port ? (debug_port => $self->debug_port) : ()),
    );
}

sub _apns {
    my $self = shift;

    my $apns = $self->__apns;
    $apns->connect unless $apns->connected;
    $apns;
}
sub _connect_to_apns { goto \&_apns }

sub _build_disconnect_timer {
    my $self = shift;

    if (my $interval = $self->disconnect_interval) {
        AnyEvent->timer(
            after    => $interval,
            interval => $interval,
            cb       => sub {
                if ($self->{__apns} && (time - ($self->_last_sent_at || 0) > $interval)) {
                    delete $self->{__apns};
                    delete $self->{_disconnect_timer};
                    infof "event:close apns";
                }
            },
        );
    }
    else { undef }
}

sub _sending {
    my $self = shift;

    $self->{_send_timer} ||= AnyEvent->timer(
        after    => $self->send_interval,
        interval => $self->send_interval,
        cb       => sub {
            my $msg = shift @{ $self->_queue };
            if ($msg) {
                $self->_send(@$msg);
            }
            else {
                delete $self->{_send_timer};
            }
        },
    );
}

sub _send {
    my ($self, $token, $payload) = @_;

    local $@;
    my $identifier;
    eval {
        $identifier = $self->_apns->send(pack("H*", $token) => {
            aps => $payload,
        });
    };

lib/APNS/Agent.pm view on Meta::CPAN

            token   => $token,
            payload => $payload,
        });
        $self->_last_sent_at(time);
        infof "event:send\ttoken:$token\tidentifier:$identifier";
        $self->{_sent}++;
        $identifier;
    }
}

sub parse_options {
    my ($class, @argv) = @_;

    require Getopt::Long;
    require Pod::Usage;
    require Hash::Rename;

    my $p = Getopt::Long::Parser->new(
        config => [qw/posix_default no_ignore_case auto_help pass_through bundling/]
    );
    $p->getoptionsfromarray(\@argv, \my %opt, qw/
        certificate=s
        private-key=s
        disconnect-interval=i
        sandbox!
        debug-port=i
    /) or Pod::Usage::pod2usage();
    Pod::Usage::pod2usage() if !$opt{certificate} || !$opt{'private-key'};

    Hash::Rename::hash_rename(\%opt, code => sub {tr/-/_/});
    (\%opt, \@argv);
}

sub run {
    my $self = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    if (!$args{listen} && !$args{port} && !$ENV{SERVER_STARTER_PORT}) {
        $args{port} = 4905;
    }
    require Plack::Loader;
    Plack::Loader->load(Twiggy => %args)->run($self->to_app);
}

1;

t/01_basic.t view on Meta::CPAN


use AnyEvent;
use AnyEvent::Socket;

use JSON::XS;
use APNS::Agent;

my $cv = AnyEvent->condvar;

my $apns_port = empty_port;
tcp_server undef, $apns_port, sub {
    my $fh = shift or die $!;
    my $handle = AnyEvent::Handle->new(fh => $fh);

    $handle->push_read( chunk => 1, sub {
        is($_[1], pack('C', 1), 'command ok');

        $handle->push_read( chunk => 4, sub {
            is($_[1], pack('N', 1), 'identifier ok');

            $handle->push_read( chunk => 4, sub {
                my $expiry = unpack('N', $_[1]);
                my $diff = $expiry - (time() + 3600*24);

                ok 0 <= $diff && $diff < 5, 'expiry ok';

                $handle->push_read( chunk => 2, sub {
                    is($_[1], pack('n', 32), 'token size ok');

                    $handle->push_read( chunk => 32, sub {
                        is($_[1], 'd'x32, 'token ok');

                        $handle->push_read( chunk => 2, sub {
                            my $payload_length = unpack('n', $_[1]);

                            $handle->push_read( chunk => $payload_length, sub {
                                my $payload = $_[1];
                                my $p = decode_json($payload);

                                is(length $payload, $payload_length, 'payload length ok');
                                is $p->{aps}->{alert}, 'ã»ã’', 'value of alert';

                                $cv->send;
                            });
                        });
                    });

t/01_basic.t view on Meta::CPAN


my $apns_agent = APNS::Agent->new(
    sandbox     => 1,
    certificate => 'dummy',
    private_key => 'dummy',
    debug_port  => $apns_port,
);

test_psgi
    app => $apns_agent->to_app,
    client => sub {
        my $cb  = shift;
        ok !$apns_agent->__apns->connected;

        my $req = POST 'http://localhost', [
            token => unpack("H*", 'd'x32),
            alert => 'ã»ã’',
        ];

        my $res = $cb->($req);
        like $res->content, qr/Accepted/;

        subtest 'monitor' => sub {
            my $req = GET 'http://localhost/monitor';

            my $res = $cb->($req);
            ok $res->is_success;
            my $result = decode_json($res->content);

            is $result->{sent}, 0;
            is $result->{queued}, 1;
        };

        $cv->recv;

        subtest 'monitor after sent' => sub {
            my $req = GET 'http://localhost/monitor';

            my $res = $cb->($req);
            ok $res->is_success;
            my $result = decode_json($res->content);

            is $result->{sent}, 1;
            is $result->{queued}, 0;
        };

( run in 0.246 second using v1.01-cache-2.11-cpan-a5abf4f5562 )