File Coverage

blib/lib/WWW/Comix/Plugin/ComicsDotCom.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package WWW::Comix::Plugin::ComicsDotCom;
2 1     1   2453 use strict;
  1         2  
  1         38  
3 1     1   6 use warnings;
  1         2  
  1         24  
4 1     1   5 use Carp;
  1         1  
  1         78  
5 1     1   1599 use List::MoreUtils qw( uniq );
  1         4905  
  1         105  
6 1     1   585 use Moose::Policy 'Moose::Policy::FollowPBP';
  0            
  0            
7             use Moose;
8             use Readonly;
9              
10             Readonly my $HOMEPAGE => 'http://www.comics.com/';
11             Readonly my $PROBEPAGE => $HOMEPAGE;
12              
13             extends qw( WWW::Comix::Plugin );
14              
15             sub get_name { return 'Comics.com'; }
16             sub get_priority { return 0 };
17              
18             sub probe {
19             my $sp = shift;
20             my $agent = $sp->get_agent(); # automatically DWIM
21             my $res = $agent->get($PROBEPAGE);
22             croak "couldn't get probe page '$PROBEPAGE': ", $res->status_line()
23             unless $res->is_success();
24              
25             my $form = $agent->form_with_fields('selectMenu')
26             or croak "no field 'selectMenu' in probe page '$PROBEPAGE'";
27              
28             my $input = $form->find_input('selectMenu');
29             my @names = map { s/\A\s+|\s+\z//g; $_ } $input->value_names();
30             my %config_for;
31             @config_for{@names} = $input->possible_values();
32             delete $config_for{$_}
33             for '', grep { m{\A \-+ \z}mxs } keys %config_for;
34             $sp->set_config(%config_for);
35              
36             return;
37             } ## end sub probe
38              
39             sub get_available_ids {
40             my $self = shift;
41              
42             my $config_for = $self->get_config();
43             my $comic = $self->get_comic();
44             croak "unhandled comic '$comic'" unless exists $config_for->{$comic};
45              
46             my @ids = $self->_get_available_ids_from($config_for->{$comic});
47              
48             if (scalar(@ids) == 2) {
49             @ids = $self->_get_available_ids_from($ids[1]);
50             shift @ids;
51             }
52             else {
53             my $link = $self->get_agent()->find_link(text => 'Next Day')
54             or croak "couldn't find 'Next Day' in feature '$comic'";
55             @ids = $self->_get_available_ids_from($ids[1])
56             unless $link->url() =~ m/ - \d{8} \.html \z /mxs;
57             }
58              
59             return @ids;
60             } ## end sub get_available_ids
61              
62             sub id_to_uri {
63             my ($self, $id) = @_;
64              
65             my $agent = $self->get_agent();
66             $agent->get($id);
67              
68             (my $radix = $id) =~ s{/.*?\z}{}mxs;
69             $radix = quotemeta $radix;
70             my $image =
71             $agent->find_image(
72             url_regex => qr/$radix .* \d{8,} \.(?: gif | png | jpg)/mxs);
73              
74             return $image->url_abs();
75             } ## end sub id_to_uri
76              
77             # Simplified guess_filename with respect to parent WWW::Comix::Plugin
78             override guess_filename => sub {
79             my $self = shift;
80             my %args = @_;
81             my $filename = $args{id} || $self->get_current_id();
82             return $self->normalise_filename(%args, filename => $filename);
83             };
84              
85             sub _get_available_ids_from {
86             my $self = shift;
87             my ($uri) = @_;
88              
89             my $agent = $self->get_agent();
90             $agent->get($HOMEPAGE);
91             $agent->get($uri);
92              
93             (my $radix = $uri) =~ s{(?:archive/)? [^/]+ \.html\z}{archive/}mxs;
94             $radix = quotemeta $radix;
95             my @uris =
96             map { $_->url() }
97             $agent->find_all_links(url_regex => qr{\A$radix .* \.html}mxs);
98              
99             push @uris, $uri;
100             return uniq reverse sort @uris;
101             } ## end sub _get_available_ids_from
102              
103             1; # Magic true value required at end of module
104             __END__
105              
106             =head1 NAME
107              
108             WWW::Comix::Plugin::ComicsDotCom - WWW::Comix plugin for http://www.comics.com/
109              
110             =head1 DESCRIPTION
111              
112             This module is not inteded for direct usage, see
113             L<WWW::Comix> and L<WWW::Comix::Plugin>.
114              
115             =head1 DIAGNOSTICS
116              
117             =over
118              
119             =item C<< no field 'selectMenu' in probe page '%s' >>
120              
121             the probe page isn't as expected, maybe it's time to update the plugin.
122              
123             =item C<< couldn't find 'Next Day' in feature '%s' >>
124              
125             the page isn't as expected, maybe it's time to update the plugin.
126              
127             =back
128              
129              
130             =head1 AUTHOR
131              
132             Flavio Poletti C<< <flavio [at] polettix [dot] it> >>
133              
134              
135             =head1 LICENCE AND COPYRIGHT
136              
137             Copyright (c) 2008, Flavio Poletti C<< <flavio [at] polettix [dot] it> >>. All rights reserved.
138              
139             This module is free software; you can redistribute it and/or
140             modify it under the same terms as Perl 5.8.x itself. See L<perlartistic>
141             and L<perlgpl>.
142              
143             Questo modulo è software libero: potete ridistribuirlo e/o
144             modificarlo negli stessi termini di Perl 5.8.x stesso. Vedete anche
145             L<perlartistic> e L<perlgpl>.
146              
147              
148             =head1 DISCLAIMER OF WARRANTY
149              
150             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
151             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
152             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
153             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
154             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
155             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
156             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
157             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
158             NECESSARY SERVICING, REPAIR, OR CORRECTION.
159              
160             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
161             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
162             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
163             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
164             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
165             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
166             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
167             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
168             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
169             SUCH DAMAGES.
170              
171             =head1 NEGAZIONE DELLA GARANZIA
172              
173             Poiché questo software viene dato con una licenza gratuita, non
174             c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
175             dalle leggi applicabili. A meno di quanto possa essere specificato
176             altrove, il proprietario e detentore del copyright fornisce questo
177             software "così com'è" senza garanzia di alcun tipo, sia essa espressa
178             o implicita, includendo fra l'altro (senza però limitarsi a questo)
179             eventuali garanzie implicite di commerciabilità e adeguatezza per
180             uno scopo particolare. L'intero rischio riguardo alla qualità ed
181             alle prestazioni di questo software rimane a voi. Se il software
182             dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
183             ed i costi per tutti i necessari servizi, riparazioni o correzioni.
184              
185             In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
186             o sia regolato da un accordo scritto, alcuno dei detentori del diritto
187             di copyright, o qualunque altra parte che possa modificare, o redistribuire
188             questo software così come consentito dalla licenza di cui sopra, potrà
189             essere considerato responsabile nei vostri confronti per danni, ivi
190             inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
191             dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
192             include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
193             di dati, l'alterazione involontaria o indesiderata di dati, le perdite
194             sostenute da voi o da terze parti o un fallimento del software ad
195             operare con un qualsivoglia altro software. Tale negazione di garanzia
196             rimane in essere anche se i dententori del copyright, o qualsiasi altra
197             parte, è stata avvisata della possibilità di tali danneggiamenti.
198              
199             Se decidete di utilizzare questo software, lo fate a vostro rischio
200             e pericolo. Se pensate che i termini di questa negazione di garanzia
201             non si confacciano alle vostre esigenze, o al vostro modo di
202             considerare un software, o ancora al modo in cui avete sempre trattato
203             software di terze parti, non usatelo. Se lo usate, accettate espressamente
204             questa negazione di garanzia e la piena responsabilità per qualsiasi
205             tipo di danno, di qualsiasi natura, possa derivarne.
206              
207             =cut