Group
Extension

App-Standby/lib/App/Standby/Service/HTTP.pm

package App::Standby::Service::HTTP;
$App::Standby::Service::HTTP::VERSION = '0.04';
BEGIN {
  $App::Standby::Service::HTTP::AUTHORITY = 'cpan:TEX';
}
# ABSTRACT: Baseclass for any simple HTTP service

use 5.010_000;
use mro 'c3';
use feature ':5.10';

use Moose;
use namespace::autoclean;

# use IO::Handle;
# use autodie;
# use MooseX::Params::Validate;
# use Carp;
# use English qw( -no_match_vars );
use Try::Tiny;
use JSON;
use LWP::UserAgent;
use URI::Escape;

# extends ...
extends 'App::Standby::Service';
# has ...
has '_ua' => (
    'is'      => 'rw',
    'isa'     => 'LWP::UserAgent',
    'lazy'    => 1,
    'builder' => '_init_ua',
);

has '_json' => (
    'is'      => 'rw',
    'isa'     => 'JSON',
    'lazy'    => 1,
    'builder' => '_init_json',
);

has 'username' => (
    'is'    => 'rw',
    'isa'   => 'Str',
    'required' => 0,
);

has 'password' => (
    'is'    => 'rw',
    'isa'   => 'Str',
    'required' => 0,
);

has 'endpoints' => (
    'is'    => 'rw',
    'isa'   => 'ArrayRef',
    'lazy'  => 1,
    'builder'   => '_init_endpoints',
);
# with ...
# initializers ...
sub _init_json {
    my $self = shift;

    my $JSON = JSON::->new->utf8();

    return $JSON;
}

sub _init_ua {
    my $self = shift;

    my $UA = LWP::UserAgent::->new();
    $UA->agent('App::Standby::Service::HTTP/0.01');

    return $UA;
}

# your code here ...
sub _build_payload {
    my $self = shift;
    my $user_ref = shift;

    my $content = $self->_json()->encode($user_ref);
    $content = URI::Escape::uri_escape($content);
    #$content =~ s/%3D/=/g;
    $content = 'queue='.$content;
    $content .= '&group_id='.$self->_config_value($self->name().'_group_id');

    return $content;
}

sub _update {
    my $self = shift;
    my $user_ref = shift;

    my $count = 0;

    foreach my $endpoint (@{$self->endpoints()}) {
        $self->logger()->log( message => "Updating endpoint: ".$endpoint, level => 'debug', );
        my $req = HTTP::Request::->new( POST => $endpoint );
        $req->content_type('application/x-www-form-urlencoded');
        my $payload = $self->_build_payload($user_ref);
        $req->content($payload);
        $self->logger()->log( message => "Payload: ".$payload, level => 'debug', );

        if($self->username() && $self->password()) {
            $req->authorization_basic( $self->username(), $self->password() );
        }

        my $content;
        my $response;
        my $prev_alarm = 0;

        my $success = try {
            local $SIG{ALRM} = sub { die "alarm-standby-service\n"; };
            $prev_alarm = alarm 10;
            $response   = $self->_ua()->request($req);
            if ( !$response->is_success ) {
                my $msg = "ERROR Request to $endpoint failed: " . $response->code() . ' - ' . $response->message();
                $self->logger()->log( message => $msg, level => 'error', );
                die( $msg );
            }
            $content = $response->content;
            if ( !$content ) {
                my $msg = "ERROR No content at $endpoint : " . $response->code() . ' - ' . $response->message();
                $self->logger()->log( message => $msg, level => 'error', );
                die( $msg );
            }
            1;    # make sure $success has a true value ...
        }
        catch {
            $self->logger()->log( message => "Request failed: ".$_, level => 'debug', );
        }
        finally {

            # make sure the alarm is off
            alarm $prev_alarm;
        };

        $count++ if $success;
    }

    return $count;
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding utf-8

=head1 NAME

App::Standby::Service::HTTP - Baseclass for any simple HTTP service

=head1 NAME

App::Standby::Service::HTTP - Baseclass for any simple HTTP service

=head1 AUTHOR

Dominik Schulz <dominik.schulz@gauner.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Dominik Schulz.

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

=cut


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.