File Coverage

blib/lib/WWW/AUR.pm
Criterion Covered Total %
statement 60 67 89.5
branch 6 12 50.0
condition 3 6 50.0
subroutine 16 17 94.1
pod 1 2 50.0
total 86 104 82.6


line stmt bran cond sub pod time code
1             package WWW::AUR;
2              
3 12     12   40591 use warnings 'FATAL' => 'all';
  12         14  
  12         388  
4 12     12   37 use strict;
  12         12  
  12         178  
5              
6 12     12   33 use Exporter;
  12         13  
  12         327  
7 12     12   34 use Carp qw();
  12         12  
  12         153  
8 12     12   36 use File::Spec qw();
  12         10  
  12         785  
9              
10             BEGIN {
11             # We must define these as soon as possible. They are used in other
12             # WWW::AUR modules. Like the ones we use after this block...
13              
14 12     12   18 our $VERSION = '0.22';
15 12         22 our $BASEPATH = '/tmp/WWW-AUR';
16 12         10 our $HOST = 'aur.archlinux.org';
17 12         17 our $UA = 'WWW::AUR::UserAgent';
18              
19 12         89 our @ISA = qw(Exporter);
20 12         186 our @EXPORT_OK = qw(_is_path_param _path_params
21             _category_name _category_index
22             _useragent);
23             }
24              
25 12     12   2453 use WWW::AUR::RPC;
  12         15  
  12         1366  
26              
27             #---CONSTRUCTOR---
28             sub new
29             {
30 2     2 0 10 my $class = shift;
31 2         5 return bless { _path_params( @_ ) }, $class
32             }
33              
34             #---PUBLIC METHOD---
35             sub search
36             {
37 2     2 1 253 my ($self, $query) = @_;
38 2         8 my $found_ref = WWW::AUR::RPC::search( $query );
39              
40 2         819 require WWW::AUR::Package;
41             return map {
42 2         19 WWW::AUR::Package->new( $_->{name}, info => $_, %$self );
  6846         14864  
43             } @$found_ref;
44             }
45              
46             #---HELPER FUNCTION---
47             sub _def_wrapper_method
48             {
49 48     48   51 my ($name, $class) = @_;
50              
51 12     12   48 no strict 'refs';
  12         14  
  12         4739  
52 48         158 *{ "WWW::AUR::$name" } = sub {
53 2     2   5 my $self = shift;
54 2         551 eval "require $class";
55 2 50       10 if ( $@ ) {
56 0         0 Carp::confess "Failed to load $class module:\n$@";
57             }
58 2         3 return eval { $class->new( @_, %$self ) };
  2         19  
59 48         107 };
60             }
61              
62             _def_wrapper_method( 'find' => 'WWW::AUR::Package' );
63             _def_wrapper_method( 'maintainer' => 'WWW::AUR::Maintainer' );
64             _def_wrapper_method( 'iter' => 'WWW::AUR::Iterator' );
65             _def_wrapper_method( 'login' => 'WWW::AUR::Login' );
66              
67             #-----------------------------------------------------------------------------
68             # UTILITY FUNCTIONS
69             #-----------------------------------------------------------------------------
70             # These functions are used internally by other WWW::AUR modules...
71              
72             my %_IS_PATH_PARAM = map { ( $_ => 1 ) }
73             qw/ basepath dlpath extpath destpath /;
74              
75             #---INTERNAL FUNCTION---
76             sub _is_path_param
77             {
78 38934     38934   23926 my ($name) = @_;
79 38934         65600 return $_IS_PATH_PARAM{ $name };
80             }
81              
82             #---INTERNAL FUNCTION---
83             sub _path_params
84             {
85 8777     8777   11563 my @filterme = @_;
86 8777         5311 my %result;
87              
88             FILTER_LOOP:
89 8777         12168 while ( my $key = shift @filterme ) {
90 38934 100       31691 next unless _is_path_param( $key );
91 20896 50       25601 my $val = shift @filterme or last FILTER_LOOP;
92 20896         33203 $result{ $key } = $val;
93             }
94              
95             # Fill path parameters with default values if they are unspecified...
96 8777         5280 our $BASEPATH;
97 8777   66     11991 my $base = $result{ 'basepath' } || $BASEPATH;
98 8777         80903 return ( 'dlpath' => File::Spec->catdir( $base, 'src' ),
99             'extpath' => File::Spec->catdir( $base, 'build' ),
100             'destpath' => File::Spec->catdir( $base, 'cache' ),
101             %result );
102             }
103              
104             my @_CATEGORIES = qw{ daemons devel editors emulators games gnome
105             i18n kde lib modules multimedia network office
106             science system x11 xfce kernels fonts };
107              
108             #---INTERNAL FUNCTION---
109             sub _category_name
110             {
111 13876     13876   9674 my ($i) = @_;
112 13876         8515 $i -= 2;
113 13876 50 33     21197 if ( $i >= 0 && $i <= $#_CATEGORIES ) {
114 0         0 return $_CATEGORIES[$i];
115             } else {
116 13876         28699 return 'undefined';
117             }
118             }
119              
120             #---INTERNAL FUNCTION---
121             sub _category_index
122             {
123 0     0   0 my ($name) = @_;
124 0         0 $name = lc $name;
125              
126 0         0 for my $i ( 0 .. $#_CATEGORIES ) {
127 0 0       0 return 2 + $i if $name eq $_CATEGORIES[ $i ];
128             }
129              
130 0         0 Carp::croak "$name is not a valid category name";
131             }
132              
133             #---INTERNAL FUNCTION---
134             # Create a user-agent object. The class name is specified in $UA.
135             sub _useragent
136             {
137 124     124   162 our $UA;
138 124 50       55561 eval "require $UA" or die;
139 124         847 return $UA->new(@_);
140             }
141              
142             1;