File Coverage

blib/lib/JIRA/REST/OAuth.pm
Criterion Covered Total %
statement 35 105 33.3
branch 0 28 0.0
condition 0 9 0.0
subroutine 12 18 66.6
pod 4 4 100.0
total 51 164 31.1


line stmt bran cond sub pod time code
1             package JIRA::REST::OAuth;
2              
3 1     1   64009 use base qw(JIRA::REST);
  1         3  
  1         571  
4              
5 1     1   75870 use 5.010;
  1         3  
6 1     1   6 use strict;
  1         2  
  1         22  
7 1     1   6 use warnings;
  1         2  
  1         23  
8 1     1   5 use utf8;
  1         2  
  1         6  
9              
10 1     1   26 use Carp qw(croak);
  1         2  
  1         42  
11              
12 1     1   499 use Net::OAuth();
  1         627  
  1         21  
13 1     1   413 use Net::OAuth::ProtectedResourceRequest();
  1         10183  
  1         24  
14 1     1   491 use Crypt::OpenSSL::RSA();
  1         6275  
  1         25  
15 1     1   11 use HTTP::Headers();
  1         3  
  1         26  
16 1     1   5 use URI();
  1         2  
  1         14  
17 1     1   858 use CGI();
  1         31066  
  1         970  
18              
19             our $VERSION = '1.03';
20              
21             sub new
22             {
23 0     0 1   my $proto = shift;
24 0   0       my $class = ref($proto) || $proto;
25              
26 0           my %args;
27 0 0 0       if (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') {
      0        
28 0           %args = %{ $_[0] };
  0            
29             }
30             else {
31 0           %args = @_;
32             }
33              
34             # remove arguments for this subclass
35 0           my @opts = qw( rsa_private_key oauth_token oauth_token_secret consumer_key );
36 0           my %a;
37 0           foreach my $opt (@opts) {
38 0 0         croak __PACKAGE__.'::new requires argument '.$opt unless defined $args{$opt};
39 0           $a{$opt} = delete $args{$opt};
40             }
41              
42             # some sane defaults JIRA::REST
43 0 0         $args{anonymous} = 1 unless exists $args{anonymous};
44              
45 0 0         my $url = $args{url} if exists $args{url};
46 0           my $self = $class->SUPER::new(\%args);
47 0           $$self{url} = $url;
48              
49             # handle our options
50 0 0         if (-e $a{rsa_private_key}) {
51 0 0         open(my $fh, '<', $a{rsa_private_key}) or die "Unable to read $a{rsa_private_key}! $!";
52 0           local $/ = undef;
53 0           my $data = <$fh>;
54 0           close($fh);
55              
56 0           $a{rsa_private_key} = Crypt::OpenSSL::RSA->new_private_key($data);
57             }
58             else {
59 0           $a{rsa_private_key} = Crypt::OpenSSL::RSA->new_private_key($a{rsa_private_key});
60             }
61              
62 0           foreach my $opt (@opts) {
63 0           $$self{$opt} = delete $a{$opt};
64             }
65              
66 0           return $self;
67             }
68              
69             sub _generate_oauth_request
70             {
71 0     0     my ($self, $method, $path, $query, $content, $headers) = @_;
72              
73 0           $path = $self->_build_path($path, $query);
74              
75             # handle headers
76 0 0         if ($method =~ /^(?:PUT|POST)$/) {
77 0           my $h;
78 0 0         if ($headers) {
79 0 0         eval { $h = $headers->clone(); } or do {
  0            
80 0           $h = HTTP::Headers->new();
81 0           $h->header(%$headers);
82             };
83             }
84             else {
85 0           $h = HTTP::Headers->new();
86             }
87              
88 0 0         unless (length $h->content_type) {
89 0           $h->content_type('application/json;charset=UTF-8');
90             }
91 0 0         unless (defined $h->header('Accept')) {
92 0           $h->header('Accept', 'application/json');
93             }
94 0           $headers = $h;
95             }
96              
97             # generate oauth request url
98 0           my $url = $$self{url};
99 0           $url =~ s/\/$//;
100 0           $url .= $path;
101             my %oauth_params = (
102             request_url => $url,
103             request_method => $method,
104              
105             consumer_key => $$self{consumer_key},
106             consumer_secret => 'ignore',
107             signature_method => 'RSA-SHA1',
108             protocol_version => Net::OAuth::PROTOCOL_VERSION_1_0,
109             signature_key => $$self{rsa_private_key},
110             token => $$self{oauth_token},
111             token_secret => $$self{oauth_token_secret},
112              
113 0           timestamp => time,
114             nonce => int(rand(2**32)),
115             );
116 0 0         if (defined $query) {
117 0           $oauth_params{extra_params} = $query;
118             }
119 0           my $request = Net::OAuth::ProtectedResourceRequest->new(%oauth_params);
120 0           $request->sign;
121              
122             # combine path and ouath request query stirings
123 0           my %params;
124 0 0         if ($path =~ /\?(.+)$/) {
125 0           my $c = CGI->new($1);
126 0           foreach my $param ($c->param) {
127 0           $params{$param} = $c->param($param);
128             }
129             }
130              
131             # oauth query strings win
132 0           %params = (%params, %{ $request->to_hash });
  0            
133              
134             # rebuild path
135 0           $path =~ s/\?.+$//;
136 0           $query = \%params;
137              
138 0           my @rv = ($path, $query);
139 0 0         if ($method =~ /^(?:POST|PUT)$/) {
140 0           @rv = ($path, $query, $content, { $headers->flatten() });
141             }
142              
143 0           return @rv;
144             }
145              
146             sub GET
147             {
148 0     0 1   my $self = shift;
149 0           return $self->SUPER::GET($self->_generate_oauth_request('GET', @_));
150             }
151              
152             sub DELETE
153             {
154 0     0     my $self = shift;
155 0           return $self->SUPER::DELETE($self->_generate_oauth_request('DELETE', @_));
156             }
157              
158             sub PUT
159             {
160 0     0 1   my $self = shift;
161 0           return $self->SUPER::PUT($self->_generate_oauth_request('PUT', @_));
162             }
163              
164             sub POST
165             {
166 0     0 1   my $self = shift;
167 0           return $self->SUPER::POST($self->_generate_oauth_request('POST', @_));
168             }
169              
170             1;
171              
172             __END__