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 |