File Coverage

blib/lib/WWW/AUR/RPC.pm
Criterion Covered Total %
statement 83 88 94.3
branch 15 24 62.5
condition 4 6 66.6
subroutine 11 11 100.0
pod 0 4 0.0
total 113 133 84.9


line stmt bran cond sub pod time code
1             package WWW::AUR::RPC;
2              
3 12     12   1819 use warnings 'FATAL' => 'all';
  12         68  
  12         452  
4 12     12   56 use strict;
  12         28  
  12         1224  
5              
6 12     12   11711 use JSON qw();
  12         197015  
  12         372  
7 12     12   111 use Carp qw();
  12         23  
  12         251  
8              
9 12     12   7212 use WWW::AUR::URI qw( rpc_uri );
  12         35  
  12         968  
10 12     12   127 use WWW::AUR qw( _category_name _useragent );
  12         23  
  12         13196  
11              
12             my %_RENAME_FOR = ( 'Description' => 'desc',
13             'NumVotes' => 'votes',
14             'CategoryID' => 'category',
15             'OutOfDate' => 'outdated',
16             'FirstSubmitted' => 'ctime',
17             'LastModified' => 'mtime',
18             );
19              
20             #---HELPER FUNCTION---
21             # Purpose: Map JSON package info keys to their new names...
22             sub _munge_result
23             {
24 6868     6868   8340 my ($info_ref) = @_;
25              
26 6868         6576 my %result;
27 6868         42514 for my $key ( keys %$info_ref ) {
28 103020   66     320861 my $newkey = $_RENAME_FOR{ $key } || lc $key;
29 103020         727203 $result{ $newkey } = $info_ref->{ $key };
30             }
31              
32 6868         27820 $result{category} = _category_name( $result{category} );
33              
34 6868         3054145 return \%result;
35             }
36              
37             #---CLASS/OBJECT METHOD---
38             sub info
39             {
40 109     109 0 1638 my ($name) = @_;
41              
42 109         645 my $uri = rpc_uri( "info", $name );
43 109         1178 my $ua = _useragent();
44 109         103088 $ua->InitTLS;
45 109         674 my $resp = $ua->get( $uri );
46              
47 109 50       112376587 Carp::croak 'Failed to call info AUR RPC: ' . $resp->status_line
48             unless $resp->is_success;
49              
50 109         3520 my $json = JSON->new;
51 109         1058 my $data = $json->decode( $resp->content );
52              
53 109 50       18326 if ( $data->{type} eq "error" ) {
    100          
54 0         0 Carp::croak "Remote error: $data->{results}";
55             } elsif ( $data->{resultcount} == 0 ) {
56 2         361 return undef;
57             } else {
58 107         486 return _munge_result( $data->{results} );
59             }
60             }
61              
62             sub multiinfo
63             {
64 1     1 0 538 my (@names) = @_;
65              
66 1         8 my $uri = rpc_uri( "multiinfo", @names );
67 1         10 my $ua = _useragent();
68 1         245 $ua->InitTLS;
69 1         5 my $resp = $ua->get( $uri );
70              
71 1 50       4227455 Carp::croak 'Failed to call multiinfo AUR RPC: ' . $resp->status_line
72             unless $resp->is_success;
73              
74 1         32 my $json = JSON->new;
75 1         43 my $data = $json->decode( $resp->content );
76              
77 1 50       56 if ( $data->{type} eq "error" ) {
78 0         0 Carp::croak "Remote error: $data->{results}";
79             }
80              
81 1         2 return map { _munge_result($_) } @{$data->{results}};
  2         7  
  1         3  
82             }
83              
84             sub search
85             {
86 3     3 0 1557 my ($query) = @_;
87              
88 3         7 my $regexp;
89 3 100 66     34 if ( $query =~ /\A\^/ || $query =~ /\$\z/ ) {
90 1         3 $regexp = eval { qr/$query/ };
  1         56  
91 1 50       5 if ( $@ ) {
92 0         0 Carp::croak qq{Failed to compile "$query" into regexp:\n$@};
93             }
94              
95 1         15 $query =~ s/\A\^//;
96 1         4 $query =~ s/\$\z//;
97             }
98              
99 3         23 my $uri = rpc_uri( 'search', $query );
100 3         52 my $ua = _useragent();
101 3         3966 $ua->InitTLS;
102 3         32 my $resp = $ua->get( $uri );
103 3 50       9213905 Carp::croak 'Failed to search AUR using RPC: ' . $resp->status_line
104             unless $resp->is_success;
105              
106 3         185 my $json = JSON->new;
107 3         22 my $data = $json->decode( $resp->content );
108              
109 3 50       3695551 if ( $data->{type} eq 'error' ) {
110 0         0 Carp::croak "Remote error: $data->{results}";
111             }
112              
113 3         13 my $results = [ map { _munge_result( $_ ) } @{ $data->{results} } ];
  6749         11063  
  3         93  
114              
115 3 100       357 if ( $regexp ) {
116 1         10 $results = [ grep { $_->{name} =~ /$regexp/ } @$results ];
  2181         8808  
117             }
118              
119 3         11828 return $results;
120             }
121              
122             sub msearch
123             {
124 2     2 0 5 my ($name) = @_;
125              
126 2         13 my $aururi = rpc_uri( 'msearch', $name );
127 2         34 my $ua = _useragent();
128 2         4171 $ua->InitTLS;
129 2         18 my $resp = $ua->get( $aururi );
130 2 50       610300 Carp::croak qq{Failed to lookup maintainer using RPC:\n}
131             . $resp->status_line unless $resp->is_success;
132              
133 2         76 my $json = JSON->new;
134 2         15 my $json_ref = $json->decode( $resp->content );
135              
136 2 50       665 if ( $json_ref->{type} eq 'error' ) {
137 0         0 Carp::croak "Remote error: $json_ref->{results}";
138             }
139              
140 2         4 return [ map { _munge_result( $_ ) } @{ $json_ref->{results} } ];
  10         21  
  2         8  
141             }
142              
143             1;