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