File Coverage

blib/lib/WWW/AUR.pm
Criterion Covered Total %
statement 61 67 91.0
branch 7 12 58.3
condition 4 6 66.6
subroutine 16 17 94.1
pod 1 2 50.0
total 89 104 85.5


line stmt bran cond sub pod time code
1             package WWW::AUR;
2              
3 12     12   55792 use warnings 'FATAL' => 'all';
  12         20  
  12         534  
4 12     12   52 use strict;
  12         13  
  12         309  
5              
6 12     12   40 use Exporter;
  12         17  
  12         454  
7 12     12   48 use Carp qw();
  12         15  
  12         180  
8 12     12   48 use File::Spec qw();
  12         15  
  12         975  
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   24 our $VERSION = '0.19';
15 12         27 our $BASEPATH = '/tmp/WWW-AUR';
16 12         24 our $HOST = 'aur.archlinux.org';
17 12         13 our $UA = 'WWW::AUR::UserAgent';
18              
19 12         122 our @ISA = qw(Exporter);
20 12         245 our @EXPORT_OK = qw(_is_path_param _path_params
21             _category_name _category_index
22             _useragent);
23             }
24              
25 12     12   2752 use WWW::AUR::RPC;
  12         21  
  12         1642  
26              
27             #---CONSTRUCTOR---
28             sub new
29             {
30 2     2 0 15 my $class = shift;
31 2         7 return bless { _path_params( @_ ) }, $class
32             }
33              
34             #---PUBLIC METHOD---
35             sub search
36             {
37 2     2 1 394 my ($self, $query) = @_;
38 2         11 my $found_ref = WWW::AUR::RPC::search( $query );
39              
40 2         772 require WWW::AUR::Package;
41 4667         14758 return map {
42 2         115 WWW::AUR::Package->new( $_->{name}, info => $_, %$self );
43             } @$found_ref;
44             }
45              
46             #---HELPER FUNCTION---
47             sub _def_wrapper_method
48             {
49 48     48   65 my ($name, $class) = @_;
50              
51 12     12   57 no strict 'refs';
  12         16  
  12         5364  
52 48         196 *{ "WWW::AUR::$name" } = sub {
53 2     2   8 my $self = shift;
54 2         798 eval "require $class";
55 2 50       12 if ( $@ ) {
56 0         0 Carp::confess "Failed to load $class module:\n$@";
57             }
58 2         3 return eval { $class->new( @_, %$self ) };
  2         23  
59 48         136 };
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 24129     24129   17626 my ($name) = @_;
79 24129         52551 return $_IS_PATH_PARAM{ $name };
80             }
81              
82             #---INTERNAL FUNCTION---
83             sub _path_params
84             {
85 4793     4793   8283 my @filterme = @_;
86 4793         3591 my %result;
87              
88             FILTER_LOOP:
89 4793         7757 while ( my $key = shift @filterme ) {
90 24129 100       24624 next unless _is_path_param( $key );
91 14259 50       22663 my $val = shift @filterme or last FILTER_LOOP;
92 14259         28327 $result{ $key } = $val;
93             }
94              
95             # Fill path parameters with default values if they are unspecified...
96 4793         3723 our $BASEPATH;
97 4793   66     9158 my $base = $result{ 'basepath' } || $BASEPATH;
98 4793         61178 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 7039     7039   5504 my ($i) = @_;
112 7039         5307 $i -= 2;
113 7039 100 66     19275 if ( $i >= 0 && $i <= $#_CATEGORIES ) {
114 6767         12711 return $_CATEGORIES[$i];
115             } else {
116 272         469 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 126     126   499 our $UA;
138 126 50       105029 eval "require $UA" or die;
139 126         1686 return $UA->new(@_);
140             }
141              
142             1;