File Coverage

blib/lib/WWW/Google/PageSpeedOnline/Params.pm
Criterion Covered Total %
statement 35 37 94.5
branch 19 26 73.0
condition 7 9 77.7
subroutine 9 10 90.0
pod 0 5 0.0
total 70 87 80.4


line stmt bran cond sub pod time code
1             package WWW::Google::PageSpeedOnline::Params;
2              
3             $WWW::Google::PageSpeedOnline::Params::VERSION = '0.27';
4             $WWW::Google::PageSpeedOnline::Params::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             WWW::Google::PageSpeedOnline::Params - Placeholder for parameters for L.
9              
10             =head1 VERSION
11              
12             Version 0.27
13              
14             =cut
15              
16 4     4   97 use 5.006;
  4         15  
17 4     4   24 use strict; use warnings;
  4     4   11  
  4         91  
  4         24  
  4         8  
  4         140  
18 4     4   32 use Data::Dumper;
  4         8  
  4         237  
19 4     4   1900 use parent 'Exporter';
  4         1228  
  4         25  
20              
21             our @EXPORT_OK = qw(validate $FIELDS);
22              
23             my $STRATEGIES = { desktop => 1, mobile => 1 };
24              
25             my $RULES = {
26             'AVOIDCSSIMPORT' => 1, 'INLINESMALLJAVASCRIPT' => 1, 'SPECIFYCHARSETEARLY' => 1,
27             'SPECIFYACACHEVALIDATOR' => 1, 'SPECIFYIMAGEDIMENSIONS' => 1, 'MAKELANDINGPAGEREDIRECTSCACHEABLE' => 1,
28             'MINIMIZEREQUESTSIZE' => 1, 'PREFERASYNCRESOURCES' => 1, 'MINIFYCSS' => 1,
29             'SERVERESOURCESFROMACONSISTENTURL' => 1, 'MINIFYHTML' => 1, 'OPTIMIZETHEORDEROFSTYLESANDSCRIPTS' => 1,
30             'PUTCSSINTHEDOCUMENTHEAD' => 1, 'MINIMIZEREDIRECTS' => 1, 'INLINESMALLCSS' => 1,
31             'MINIFYJAVASCRIPT' => 1, 'DEFERPARSINGJAVASCRIPT' => 1, 'SPECIFYAVARYACCEPTENCODINGHEADER' => 1,
32             'LEVERAGEBROWSERCACHING' => 1, 'OPTIMIZEIMAGES' => 1, 'SPRITEIMAGES' => 1,
33             'REMOVEQUERYSTRINGSFROMSTATICRESOURCES' => 1, 'SERVESCALEDIMAGES' => 1, 'AVOIDBADREQUESTS' => 1,
34             'USEANAPPLICATIONCACHE' => 1,
35             };
36              
37             my $LOCALES = {
38             'ar' => 'Arabic', 'bg' => 'Bulgarian', 'ca' => 'Catalan', 'zh_TW' => 'Traditional Chinese (Taiwan)',
39             'zh_CN' => 'Simplified Chinese', 'fr' => 'Croatian', 'cs' => 'Czech', 'da' => 'Danish',
40             'nl' => 'Dutch', 'en_US' => 'English', 'en_GB' => 'English UK', 'fil' => 'Filipino',
41             'fi' => 'Finnish', 'fr' => 'French', 'de' => 'German', 'el' => 'Greek',
42             'lw' => 'Hebrew', 'hi' => 'Hindi', 'hu' => 'Hungarian', 'id' => 'Indonesian',
43             'it' => 'Italian', 'ja' => 'Japanese', 'ko' => 'Korean', 'lv' => 'Latvian',
44             'lt' => 'Lithuanian', 'no' => 'Norwegian', 'pl' => 'Polish', 'pr_BR' => 'Portuguese (Brazilian)',
45             'pt_PT' => 'Portuguese (Portugal)', 'ro' => 'Romanian', 'ru' => 'Russian', 'sr' => 'Serbian',
46             'sk' => 'Slovakian', 'sl' => 'Slovenian', 'es' => 'Spanish', 'sv' => 'Swedish',
47             'th' => 'Thai', 'tr' => 'Turkish', 'uk' => 'Ukrainian', 'vi' => 'Vietnamese',
48             };
49              
50             sub check_strategy {
51 3     3 0 7 my ($str) = @_;
52              
53             die "ERROR: Invalid data type 'strategy' found [$str]"
54 3 100       18 unless exists $STRATEGIES->{lc($str)};
55             }
56              
57             sub check_locale {
58 0     0 0 0 my ($str) = @_;
59              
60             die "ERROR: Invalid data type 'locale' found [$str]"
61 0 0       0 unless exists $LOCALES->{$str};
62             }
63              
64             sub check_url {
65 2     2 0 6 my ($str) = @_;
66              
67 2 100 66     31 die "ERROR: Invalid data type 'url' [$str]" unless (defined $str && $str =~ /^(http(?:s)?\:\/\/[a-zA-Z0-9\-]+(?:\.[a-zA-Z0-9\-]+)*\.[a-zA-Z]{2,6}(?:\/?|(?:\/[\w\-]+)*)(?:\/?|\/\w+\.[a-zA-Z]{2,4}(?:\?[\w]+\=[\w\-]+)?)?(?:\&[\w]+\=[\w\-]+)*)$/);
68             };
69              
70             sub check_rule {
71 2     2 0 4 my ($rules) = @_;
72              
73 2 50       7 return unless defined $rules;
74 2 100       14 die "ERROR: 'Rules' should be passed in as arrayref" unless (ref($rules) eq 'ARRAY');
75              
76 1         3 foreach my $rule (@$rules) {
77 1 50       14 die "ERROR: Invalid 'rule' found [$rule]" unless (exists $RULES->{uc($rule)});
78             }
79             }
80              
81             our $FIELDS = {
82             'strategy' => { check => sub { check_strategy(@_) }, type => 's' },
83             'locale' => { check => sub { check_locale(@_) }, type => 's' },
84             'url' => { check => sub { check_url(@_) }, type => 's' },
85             'rule' => { check => sub { check_rule(@_) }, type => 's' },
86             };
87              
88             sub validate {
89 7     7 0 15 my ($fields, $params) = @_;
90              
91 7 50       17 die "ERROR: Missing params list." unless (defined $params);
92              
93 7 100       25 die "ERROR: Parameters have to be hash ref" unless (ref($params) eq 'HASH');
94              
95 6         11 foreach my $key (keys %{$params}) {
  6         22  
96             die "ERROR: Received invalid param: $key"
97 14 100       41 unless (exists $FIELDS->{$key});
98             }
99              
100 5         10 foreach my $key (keys %{$fields}) {
  5         15  
101             die "ERROR: Received invalid param: $key"
102 13 50       28 unless (exists $FIELDS->{$key});
103              
104             die "ERROR: Missing mandatory param: $key"
105 13 100 100     45 if ($fields->{$key} && !exists $params->{$key});
106              
107             die "ERROR: Received undefined mandatory param: $key"
108 12 50 66     30 if ($fields->{$key} && !defined $params->{$key});
109              
110             $FIELDS->{$key}->{check}->($params->{$key})
111 12 100       38 if defined $params->{$key};
112             }
113             }
114              
115             =head1 AUTHOR
116              
117             Mohammad S Anwar, C<< >>
118              
119             =head1 REPOSITORY
120              
121             L
122              
123             =head1 BUGS
124              
125             Please report any bugs or feature requests to C
126             rt.cpan.org>, or through the web interface at L.
127             I will be notified, and then you'll automatically be notified of progress on your
128             bug as I make changes.
129              
130             =head1 SUPPORT
131              
132             You can find documentation for this module with the perldoc command.
133              
134             perldoc WWW::Google::PageSpeedOnline::Params
135              
136             You can also look for information at:
137              
138             =over 4
139              
140             =item * RT: CPAN's request tracker (report bugs here)
141              
142             L
143              
144             =item * AnnoCPAN: Annotated CPAN documentation
145              
146             L
147              
148             =item * CPAN Ratings
149              
150             L
151              
152             =item * Search CPAN
153              
154             L
155              
156             =back
157              
158             =head1 LICENSE AND COPYRIGHT
159              
160             Copyright (C) 2011 - 2015 Mohammad S Anwar.
161              
162             This program is free software; you can redistribute it and/or modify it under
163             the terms of the the Artistic License (2.0). You may obtain a copy of the full
164             license at:
165              
166             L
167              
168             Any use, modification, and distribution of the Standard or Modified Versions is
169             governed by this Artistic License.By using, modifying or distributing the Package,
170             you accept this license. Do not use, modify, or distribute the Package, if you do
171             not accept this license.
172              
173             If your Modified Version has been derived from a Modified Version made by someone
174             other than you,you are nevertheless required to ensure that your Modified Version
175             complies with the requirements of this license.
176              
177             This license does not grant you the right to use any trademark, service mark,
178             tradename, or logo of the Copyright Holder.
179              
180             This license includes the non-exclusive, worldwide, free-of-charge patent license
181             to make, have made, use, offer to sell, sell, import and otherwise transfer the
182             Package with respect to any patent claims licensable by the Copyright Holder that
183             are necessarily infringed by the Package. If you institute patent litigation
184             (including a cross-claim or counterclaim) against any party alleging that the
185             Package constitutes direct or contributory patent infringement,then this Artistic
186             License to you shall terminate on the date that such litigation is filed.
187              
188             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
189             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
190             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
191             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
192             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
193             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
194             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
195              
196             =cut
197              
198             1; # End of WWW::Google::PageSpeedOnline::Params