File Coverage

blib/lib/JIRA/REST/OAuth.pm
Criterion Covered Total %
statement 35 104 33.6
branch 0 28 0.0
condition 0 9 0.0
subroutine 12 18 66.6
pod 4 4 100.0
total 51 163 31.2


line stmt bran cond sub pod time code
1             package JIRA::REST::OAuth;
2              
3 1     1   63993 use base qw(JIRA::REST);
  1         3  
  1         583  
4              
5 1     1   77193 use 5.010;
  1         4  
6 1     1   6 use strict;
  1         2  
  1         22  
7 1     1   5 use warnings;
  1         3  
  1         24  
8 1     1   6 use utf8;
  1         2  
  1         14  
9              
10 1     1   28 use Carp qw(croak);
  1         1  
  1         44  
11              
12 1     1   513 use Net::OAuth();
  1         635  
  1         26  
13 1     1   434 use Net::OAuth::ProtectedResourceRequest();
  1         10091  
  1         23  
14 1     1   493 use Crypt::OpenSSL::RSA();
  1         6385  
  1         26  
15 1     1   15 use HTTP::Headers();
  1         2  
  1         15  
16 1     1   5 use URI();
  1         1  
  1         25  
17 1     1   887 use CGI();
  1         31689  
  1         997  
18              
19             our $VERSION = '1.02';
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             # handle headers
74 0 0         if ($method =~ /^(?:PUT|POST)$/) {
75 0           my $h;
76 0 0         if ($headers) {
77 0 0         eval { $h = $headers->clone(); } or do {
  0            
78 0           $h = HTTP::Headers->new();
79 0           $h->header(%$headers);
80             };
81             }
82             else {
83 0           $h = HTTP::Headers->new();
84             }
85              
86 0 0         unless (defined $h->content_type) {
87 0           $h->content_type('application/json;charset=UTF-8');
88             }
89 0 0         unless (defined $h->header('Accept')) {
90 0           $h->header('Accept', 'application/json');
91             }
92 0           $headers = $h;
93             }
94              
95             # generate oauth request url
96 0           my $url = $$self{url};
97 0           $url =~ s/\/$//;
98 0           $url .= $path;
99             my %oauth_params = (
100             request_url => $url,
101             request_method => $method,
102              
103             consumer_key => $$self{consumer_key},
104             consumer_secret => 'ignore',
105             signature_method => 'RSA-SHA1',
106             protocol_version => Net::OAuth::PROTOCOL_VERSION_1_0,
107             signature_key => $$self{rsa_private_key},
108             token => $$self{oauth_token},
109             token_secret => $$self{oauth_token_secret},
110              
111 0           timestamp => time,
112             nonce => int(rand(2**32)),
113             );
114 0 0         if (defined $query) {
115 0           $oauth_params{extra_params} = $query;
116             }
117 0           my $request = Net::OAuth::ProtectedResourceRequest->new(%oauth_params);
118 0           $request->sign;
119              
120             # combine path and ouath request query stirings
121 0           my %params;
122 0 0         if ($path =~ /\?(.+)$/) {
123 0           my $c = CGI->new($1);
124 0           foreach my $param ($c->param) {
125 0           $params{$param} = $c->param($param);
126             }
127             }
128              
129             # oauth query strings win
130 0           %params = (%params, %{ $request->to_hash });
  0            
131              
132             # rebuild path
133 0           $path =~ s/\?.+$//;
134 0           $query = \%params;
135              
136 0           my @rv = ($path, $query);
137 0 0         if ($method =~ /^(?:POST|PUT)$/) {
138 0           @rv = ($path, $query, $content, $headers);
139             }
140              
141 0           return @rv;
142             }
143              
144             sub GET
145             {
146 0     0 1   my $self = shift;
147 0           return $self->SUPER::GET($self->_generate_oauth_request('GET', @_));
148             }
149              
150             sub DELETE
151             {
152 0     0     my $self = shift;
153 0           return $self->SUPER::DELETE($self->_generate_oauth_request('DELETE', @_));
154             }
155              
156             sub PUT
157             {
158 0     0 1   my $self = shift;
159 0           return $self->SUPER::PUT($self->_generate_oauth_request('PUT', @_));
160             }
161              
162             sub POST
163             {
164 0     0 1   my $self = shift;
165 0           return $self->SUPER::POST($self->_generate_oauth_request('POST', @_));
166             }
167              
168             1;
169              
170             __END__