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 |