| 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 |