File Coverage

blib/lib/WWW/AUR/URI.pm
Criterion Covered Total %
statement 42 43 97.6
branch 3 4 75.0
condition n/a
subroutine 11 12 91.6
pod 5 5 100.0
total 61 64 95.3


line stmt bran cond sub pod time code
1             package WWW::AUR::URI;
2              
3 12     12   16434 use warnings 'FATAL' => 'all';
  12         20  
  12         557  
4 12     12   46 use strict;
  12         32  
  12         304  
5              
6 12     12   41 use Carp qw();
  12         13  
  12         123  
7 12     12   5983 use URI qw();
  12         45627  
  12         311  
8 12     12   82 use Exporter qw();
  12         16  
  12         160  
9              
10 12     12   1888 use WWW::AUR qw(); # for global variables
  12         18  
  12         5149  
11              
12             our @ISA = qw(Exporter);
13             our @EXPORT_OK = qw(pkgfile_uri pkgbuild_uri pkgsubmit_uri pkg_uri rpc_uri);
14             our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
15             our $Scheme = 'https';
16              
17             sub _pkgdir
18             {
19 19     19   27 my ($pkgname) = @_;
20 19         44 my $pre = substr $pkgname, 0, 2;
21 19         55 return "packages/$pre/$pkgname";
22             }
23              
24             sub pkgfile_uri
25             {
26 14     14 1 329 my ($pkgname) = @_;
27 14         37 my $dir = _pkgdir($pkgname);
28 14         211 return "$Scheme://$WWW::AUR::HOST/$dir/$pkgname.tar.gz";
29             }
30              
31             sub pkgbuild_uri
32             {
33 5     5 1 8 my ($pkgname) = @_;
34 5         15 my $dir = _pkgdir($pkgname);
35 5         28 return "$Scheme://$WWW::AUR::HOST/$dir/PKGBUILD"
36             }
37              
38             sub pkgsubmit_uri
39             {
40 0     0 1 0 return "$Scheme://$WWW::AUR::HOST/submit/";
41             }
42              
43             sub pkg_uri
44             {
45 4     4 1 16 my %params = @_;
46 4         40 my $uri = URI->new( "$Scheme://$WWW::AUR::HOST/packages/" );
47 4         7670 $uri->query_form([ %params ]);
48 4         603 return $uri->as_string;
49             }
50              
51             my @_RPC_METHODS = qw/ search info multiinfo msearch /;
52              
53             sub rpc_uri
54             {
55 123     123 1 2082 my $method = shift;
56              
57 492         1218 Carp::croak( "$method is not a valid AUR RPC method" )
58 123 50       481 unless grep { $_ eq $method } @_RPC_METHODS;
59              
60             # The RPC only works with https.
61 123         943 my $uri = URI->new( "$Scheme://$WWW::AUR::HOST/rpc" );
62              
63 123         75665 my @qparms = ( 'type' => $method );
64 123 100       374 if ($method eq 'multiinfo') {
65 2         5 push @qparms, map { ( 'arg[]' => $_ ) } @_;
  4         11  
66             }
67             else {
68 121         368 push @qparms, ( 'arg' => shift );
69             }
70              
71 123         701 $uri->query_form( \@qparms );
72 123         12491 return $uri->as_string;
73             }
74              
75             1;