File Coverage

blib/lib/Log/Dispatch/HipChat.pm
Criterion Covered Total %
statement 24 64 37.5
branch 0 12 0.0
condition 0 11 0.0
subroutine 8 17 47.0
pod 0 3 0.0
total 32 107 29.9


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   459 use strict;
  1         1  
  1         32  
6 1     1   5 use warnings;
  1         1  
  1         39  
7            
8             our $VERSION = '0.0005';
9              
10 1     1   426 use WebService::HipChat;
  1         247176  
  1         39  
11 1     1   572 use Log::Dispatch::Output;
  1         9962  
  1         29  
12 1     1   9 use Try::Tiny;
  1         2  
  1         51  
13 1     1   3 use JSON::XS qw/decode_json/;
  1         1  
  1         55  
14            
15 1     1   4 use base qw( Log::Dispatch::Output );
  1         1  
  1         70  
16              
17 1     1   3 use Params::Validate qw(validate SCALAR BOOLEAN);
  1         2  
  1         522  
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 0           print Dump( $http_response );
90             # Try to decode the response content
91             try{
92 0     0     my $response = HTTP::Response->parse( $http_response );
93 0           my $data = decode_json( $response->decoded_content );
94 0 0         if( $data->{error}{message} ){
95 0           die( sprintf( "Failed to send message to room (%s): %s", $self->{room}, $data->{error}{message} ) );
96             }else{
97 0           die( "Could not find error message..." );
98             }
99             }catch{
100 0     0     die( $_ );
101 0           $self->log->error( sprintf( "Failed to send message to room (%s): %s", $self->{room}, $http_response ) );
102 0           };
103             }
104             }
105            
106            
107             1;
108              
109             =head1 NAME
110              
111             Log::Dispatch::HipChat
112              
113             =head1 DESCRIPTION
114              
115             Send log messages to HipChat
116              
117             =head1 SYNOPSIS
118              
119             log4perl.appender.hipchat=Log::Dispatch::HipChat
120             log4perl.appender.hipchat.auth_token=your-auth-token
121             log4perl.appender.hipchat.room=room-to-talk-to
122             log4perl.appender.hipchat.color=color <-- optional
123              
124             =head1 COPYRIGHT
125              
126             Copyright 2015, Robin Clarke
127              
128             =head1 AUTHOR
129              
130             Robin Clarke
131