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