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   887 use warnings 'FATAL' => 'all';
  12         42  
  12         359  
4 12     12   37 use strict;
  12         15  
  12         185  
5              
6 12     12   5665 use JSON qw();
  12         95364  
  12         204  
7 12     12   49 use Carp qw();
  12         8  
  12         163  
8              
9 12     12   3352 use WWW::AUR::URI qw( rpc_uri );
  12         18  
  12         575  
10 12     12   45 use WWW::AUR qw( _category_name _useragent );
  12         9  
  12         7751  
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 13876     13876   9378 my ($info_ref) = @_;
25              
26 13876         7889 my %result;
27 13876         32918 for my $key ( keys %$info_ref ) {
28 208140   66     322149 my $newkey = $_RENAME_FOR{ $key } || lc $key;
29 208140         201768 $result{ $newkey } = $info_ref->{ $key };
30             }
31              
32 13876         24506 $result{category} = _category_name( $result{category} );
33              
34 13876         21569 return \%result;
35             }
36              
37             #---CLASS/OBJECT METHOD---
38             sub info
39             {
40 109     109 0 764 my ($name) = @_;
41              
42 109         453 my $uri = rpc_uri( "info", $name );
43 109         778 my $ua = _useragent();
44 109         30365 $ua->InitTLS;
45 109         347 my $resp = $ua->get( $uri );
46              
47 109 50       12735456 Carp::croak 'Failed to call info AUR RPC: ' . $resp->status_line
48             unless $resp->is_success;
49              
50 109         2204 my $json = JSON->new;
51 109         538 my $data = $json->decode( $resp->content );
52              
53 109 50       4910 if ( $data->{type} eq "error" ) {
    100          
54 0         0 Carp::croak "Remote error: $data->{results}";
55             } elsif ( $data->{resultcount} == 0 ) {
56 1         333 return undef;
57             } else {
58 108         369 return _munge_result( $data->{results} );
59             }
60             }
61              
62             sub multiinfo
63             {
64 1     1 0 699 my (@names) = @_;
65              
66 1         159 my $uri = rpc_uri( "multiinfo", @names );
67 1         9 my $ua = _useragent();
68 1         228 $ua->InitTLS;
69 1         5 my $resp = $ua->get( $uri );
70              
71 1 50       110178 Carp::croak 'Failed to call multiinfo AUR RPC: ' . $resp->status_line
72             unless $resp->is_success;
73              
74 1         38 my $json = JSON->new;
75 1         57 my $data = $json->decode( $resp->content );
76              
77 1 50       215 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}};
  4         5  
  1         4  
82             }
83              
84             sub search
85             {
86 3     3 0 1170 my ($query) = @_;
87              
88 3         4 my $regexp;
89 3 100 66     24 if ( $query =~ /\A\^/ || $query =~ /\$\z/ ) {
90 1         2 $regexp = eval { qr/$query/ };
  1         17  
91 1 50       4 if ( $@ ) {
92 0         0 Carp::croak qq{Failed to compile "$query" into regexp:\n$@};
93             }
94              
95 1         3 $query =~ s/\A\^//;
96 1         2 $query =~ s/\$\z//;
97             }
98              
99 3         13 my $uri = rpc_uri( 'search', $query );
100 3         25 my $ua = _useragent();
101 3         2229 $ua->InitTLS;
102 3         16 my $resp = $ua->get( $uri );
103 3 50       1115784 Carp::croak 'Failed to search AUR using RPC: ' . $resp->status_line
104             unless $resp->is_success;
105              
106 3         67 my $json = JSON->new;
107 3         15 my $data = $json->decode( $resp->content );
108              
109 3 50       50075 if ( $data->{type} eq 'error' ) {
110 0         0 Carp::croak "Remote error: $data->{results}";
111             }
112              
113 3         12 my $results = [ map { _munge_result( $_ ) } @{ $data->{results} } ];
  10146         8483  
  3         38  
114              
115 3 100       262 if ( $regexp ) {
116 1         8 $results = [ grep { $_->{name} =~ /$regexp/ } @$results ];
  3289         5888  
117             }
118              
119 3         11676 return $results;
120             }
121              
122             sub msearch
123             {
124 2     2 0 4 my ($name) = @_;
125              
126 2         8 my $aururi = rpc_uri( 'msearch', $name );
127 2         18 my $ua = _useragent();
128 2         1985 $ua->InitTLS;
129 2         13 my $resp = $ua->get( $aururi );
130 2 50       542113 Carp::croak qq{Failed to lookup maintainer using RPC:\n}
131             . $resp->status_line unless $resp->is_success;
132              
133 2         41 my $json = JSON->new;
134 2         15 my $json_ref = $json->decode( $resp->content );
135              
136 2 50       17282 if ( $json_ref->{type} eq 'error' ) {
137 0         0 Carp::croak "Remote error: $json_ref->{results}";
138             }
139              
140 2         6 return [ map { _munge_result( $_ ) } @{ $json_ref->{results} } ];
  3618         3078  
  2         17  
141             }
142              
143             1;