File Coverage

blib/lib/Log/Dispatch/HipChat.pm
Criterion Covered Total %
statement 24 63 38.1
branch 0 12 0.0
condition 0 11 0.0
subroutine 8 17 47.0
pod 0 3 0.0
total 32 106 30.1


line stmt bran cond sub pod time code
1             package Log::Dispatch::HipChat;
2              
3             # ABSTRACT: Dispatch log events to HipChat
4              
5 1     1   480 use strict;
  1         1  
  1         31  
6 1     1   4 use warnings;
  1         1  
  1         36  
7            
8             our $VERSION = '0.0006';
9              
10 1     1   502 use WebService::HipChat;
  1         193354  
  1         29  
11 1     1   710 use Log::Dispatch::Output;
  1         11889  
  1         26  
12 1     1   6 use Try::Tiny;
  1         2  
  1         47  
13 1     1   4 use JSON::XS qw/decode_json/;
  1         2  
  1         52  
14            
15 1     1   3 use base qw( Log::Dispatch::Output );
  1         1  
  1         65  
16              
17 1     1   4 use Params::Validate qw(validate SCALAR BOOLEAN);
  1         2  
  1         441  
18             Params::Validate::validation_options( allow_extra => 1 );
19              
20 0     0 0   sub APPEND {0}
21            
22             sub new {
23 0     0 0   my $proto = shift;
24 0   0       my $class = ref $proto || $proto;
25            
26 0           my %p = @_;
27            
28 0           my $self = bless {}, $class;
29            
30 0           $self->_basic_init(%p);
31 0           $self->_make_handle;
32            
33 0           return $self;
34             }
35              
36             sub _basic_init {
37 0     0     my $self = shift;
38            
39 0           $self->SUPER::_basic_init(@_);
40            
41 0           my %p = validate(
42             @_, {
43             auth_token => { type => SCALAR },
44             room => { type => SCALAR },
45             color => { type => SCALAR, optional => 1 },
46             }
47             );
48            
49 0           $self->{room} = $p{room};
50 0           $self->{color} = $p{color};
51 0           $self->{auth_token} = $p{auth_token};
52             }
53              
54             sub _make_handle {
55 0     0     my $self = shift;
56            
57 0           $self->{client} = WebService::HipChat->new(
58             auth_token => $self->{auth_token},
59             );
60             }
61              
62             sub log_message {
63 0     0 0   my $self = shift;
64 0           my %p = @_;
65              
66 0           my $http_response;
67 0   0       my $color = $p{color} || $self->{color};
68 0 0 0       if( ! $color and $p{level} ){
69 0 0         if( $p{level} >= 4 ){
    0          
    0          
70 0           $color = 'red';
71             }elsif( $p{level} >= 3 ){
72 0           $color = 'yellow';
73             }elsif( $p{level} >=1 ){
74 0           $color = 'green';
75             }else{
76 0           $color = 'gray';
77             }
78             }
79 0   0       $color ||= 'gray';
80            
81             try{
82 0     0     $self->{client}->send_notification( $self->{room}, { color => $color, message => $p{message} } );
83             }catch{
84             # If it fails, it will die with the http response
85 0     0     $http_response = $_;
86 0           };
87              
88 0 0         if( $http_response ){
89             # Try to decode the response content
90             try{
91 0     0     my $response = HTTP::Response->parse( $http_response );
92 0           my $data = decode_json( $response->decoded_content );
93 0 0         if( $data->{error}{message} ){
94 0           die( sprintf( "Failed to send message to room (%s): %s", $self->{room}, $data->{error}{message} ) );
95             }else{
96 0           die( "Could not find error message..." );
97             }
98             }catch{
99 0     0     die( $_ );
100 0           $self->log->error( sprintf( "Failed to send message to room (%s): %s", $self->{room}, $http_response ) );
101 0           };
102             }
103             }
104            
105            
106             1;
107              
108             =head1 NAME
109              
110             Log::Dispatch::HipChat
111              
112             =head1 DESCRIPTION
113              
114             Send log messages to HipChat
115              
116             =head1 SYNOPSIS
117              
118             log4perl.appender.hipchat=Log::Dispatch::HipChat
119             log4perl.appender.hipchat.auth_token=your-auth-token
120             log4perl.appender.hipchat.room=room-to-talk-to
121             log4perl.appender.hipchat.color=color <-- optional
122              
123             =head1 COPYRIGHT
124              
125             Copyright 2015, Robin Clarke
126              
127             =head1 AUTHOR
128              
129             Robin Clarke
130