File Coverage

blib/lib/WWW/Comix/Plugin/ArcaMax.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


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