File Coverage

blib/lib/Net/Zendesk.pm
Criterion Covered Total %
statement 47 73 64.3
branch 36 62 58.0
condition 6 29 20.6
subroutine 5 9 55.5
pod 3 4 75.0
total 97 177 54.8


line stmt bran cond sub pod time code
1             package Net::Zendesk;
2 2     2   31697 use strict;
  2         4  
  2         53  
3 2     2   7 use warnings;
  2         3  
  2         59  
4 2     2   955 use MIME::Base64;
  2         1165  
  2         2224  
5              
6             our $VERSION = '0.01';
7              
8             sub new {
9 1     1 0 324 my ($class, %args) = @_;
10             die 'please provide a zendesk domain name (e.g. domain => "obscura.zendesk.com")'
11 1 50 33     14 unless $args{domain} && $args{domain} =~ /\.zendesk\.com\z/ && $args{domain} !~ m{/};
      33        
12              
13             die 'sorry! only API version 2 is supported at the moment'
14 1 50 33     4 if exists $args{api} && $args{api} != 2;
15              
16 1 50       2 die 'please provide the email of a valid zendesk account' unless $args{email};
17 1 50       3 if ($args{token}) {
    0          
18 1         5 $args{auth} = "$args{email}/token:$args{token}";
19             }
20             elsif ($args{password}) {
21 0         0 $args{auth} = "$args{email}:$args{password}";
22             }
23             else {
24 0         0 die 'please provide a password or a token for zendesk authentication. Oauth is not yet supported by this module';
25             }
26              
27             return bless {
28             _domain => $args{domain},
29             _api => $args{api},
30             _auth => MIME::Base64::encode($args{auth}),
31             _ua => $args{ua} || undef,
32 1   50     20 }, $class;
33             }
34              
35             sub create_ticket {
36 0     0 1 0 my ($self, $ticket, %extra) = @_;
37 0         0 my $path = 'tickets.json';
38 0 0       0 if (%extra) {
39 0         0 $path .= '?' . join('&', map("$_=$extra{$_}", keys %extra));
40             }
41 0         0 return $self->make_request('POST', $path, { ticket => $ticket });
42             }
43              
44             sub search {
45 0     0 1 0 my ($self, $search_args) = @_;
46 0         0 my $parsed_args = $self->_parse_search_args($search_args);
47              
48 0         0 require URI::Escape;
49 0         0 my $query = URI::Escape::uri_escape(join(' ' => @$parsed_args));
50              
51 0         0 return $self->make_request('GET', 'search.json?query=' . $query, {});
52             }
53              
54             sub make_request {
55 0     0 1 0 my ($self, $type, $path, $params) = @_;
56 0 0 0     0 die 'please provide a type' unless $type
      0        
57             && ($type eq 'GET' || $type eq 'POST' || $type eq 'PUT' || $type eq 'DELETE');
58 0 0 0     0 die 'please provide a relative path' unless $path && $path !~ m{\A/api};
59 0 0 0     0 die 'please provide a HASHREF with parameters' unless $params && ref $params eq 'HASH';
60 0         0 my $method = lc $type;
61             return $self->_ua->$method(
62 0 0 0     0 'https://' . $self->{_domain} . '/api/v2/' . $path,
63             [
64             ($method eq 'post' || $method eq 'put'
65             ? ('Content-Type' => 'application/json') : ()
66             ),
67             ],
68             $params,
69             );
70             }
71              
72             sub _parse_search_args {
73 20     20   8090 my ($self, $search_args) = @_;
74 20         20 my @query;
75 20         46 foreach my $keyword (keys %$search_args) {
76 20 50       74 die "Net::Zendesk: malformed search keyword '$keyword' contains spaces"
77             if $keyword =~ /\s/;
78 20         25 my $value = $search_args->{$keyword};
79 20 100       29 if (ref $value) {
80 15 100       28 if (ref $value eq 'HASH') {
    50          
81 13         18 foreach my $inner_key (keys %$value) {
82 15         49 my %tokens = (
83             '=' => ':',
84             '>' => '>',
85             '<' => '<',
86             '>=' => '>=',
87             '<=' => '<=',
88             '!=' => ':',
89             'or' => ':',
90             'and' => ':',
91             );
92 15 50       27 die "Net::Zendesk: invalid token '$inner_key' for keyword '$keyword'. Available tokens are " . join(', ', keys %tokens) unless exists $tokens{$inner_key};
93              
94 15         14 my $inner_value = $value->{$inner_key};
95 15 100       20 $inner_value = 'none' unless defined $inner_value;
96              
97 15 100       19 if (ref $inner_value) {
98 3 50       7 die 'Net::Zendesk: only scalar values or ARRAY references are supported. Got ' . ref($inner_value) . " for keyword '$keyword' under '$inner_key'." unless ref $inner_value eq 'ARRAY';
99 3 100 66     20 if ($inner_key eq 'and') {
    50          
100             push @query, $keyword . ':'
101             . join ' ', map {
102 1 50       3 defined $_ ? $_ =~ /\s/ ? qq("$_") : $_ : 'none'
  2 100       22  
103             } @$inner_value;
104             }
105             elsif ($inner_key eq '=' || $inner_key eq 'or') {
106 2         4 foreach my $or (@$inner_value) {
107 4 100       8 $or = 'none' unless defined $or;
108 4 50       8 $or = qq("$or") if $or =~ /\s/;
109 4         11 push @query, "$keyword$tokens{$inner_key}$or";
110             }
111             }
112             else {
113 0         0 die 'Net::Zendesk: only =,and,or tokens are allowed for references';
114             }
115             }
116             else {
117 12 100       23 $inner_value = qq("$inner_value") if $inner_value =~ /\s/;
118 12 100       46 push @query, ($inner_key eq '!=' ? '-' : '')
119             . "$keyword$tokens{$inner_key}$inner_value";
120             }
121             }
122             }
123             elsif (ref $value eq 'ARRAY') {
124 2         3 foreach my $or (@$value) {
125 4 100       7 $or = 'none' unless defined $or;
126 4 50       6 $or = qq("$or") if $or =~ /\s/;
127 4         10 push @query, "$keyword:$or";
128             }
129             }
130             else {
131 0         0 die 'Net::Zendesk: unsuported reference ' . ref($value) . '. Please use either a scalar or an ARRAY/HASH reference as a value for ' . $keyword;
132             }
133             }
134             else {
135 5 100       9 $value = 'none' unless defined $value;
136 5 100       12 $value = qq("$value") if $value =~ /\s/;
137 5         13 push @query, "$keyword:$value";
138             }
139             }
140 20         39 return \@query;
141             }
142              
143             sub _ua {
144 0     0     my ($self) = @_;
145 0 0         return $self->{_ua} if $self->{_ua};
146 0           require Furl;
147 0           require IO::Socket::SSL;
148 0           IO::Socket::SSL->import;
149             $self->{_ua} = Furl->new(
150             headers => [
151             'Accept' => 'application/json',
152             'Authorization' => 'Basic ' . $self->{_auth},
153 0           ],
154             ssl_opts => {
155             SSL_verify_mode => SSL_VERIFY_PEER(),
156             },
157             );
158             }
159              
160             1;
161             __END__