1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
#!/usr/bin/env perl
use strict;
use warnings;
use LWP::Simple;
use POSIX qw(strftime);
# Add or remove the comics you want/don't want. The comic
# configurations are kept in an hash. The key is the name of the
# comic and the value is an array reference containing the different
# parameters to get the strip. The mandatory array values are the
# following:
#
# * The URL where the daily comic is shown
# * A regular expression that will match the image file
#
# Additionally, you can specify an optional third parameter, a "base"
# URL if the root of the image is different from the URL of the page
# where we got the image. If that last element is undefined, the
# script will assume that the base URL is the same as the image page
# URL.
my %strip = (
"Penny Arcade" => ["http://www.penny-arcade.com/comic", qr'images/\d{4}/.+(gif|jpg)', "http://www.penny-arcade.com/"],
"PvP Online" => ["http://www.pvponline.com/", qr'images/\d{4}\.gif'],
"User Friendly" => ["http://userfriendly.org/", qr'cartoons/archives/\w{5}/.+\.gif'],
"The Flying McCoys" => ["http://www.ucomics.com/theflyingmccoys", qr'fmc/\d{4}/.+\.gif', "http://images.ucomics.com/comics/"],
"Joy of Tech" => ["http://www.geekculture.com/joyoftech", qr'\d{3}.?\.(png|gif|jpg)', "http://www.geekculture.com/joyoftech/joyimages/"],
"Ctrl Alt Del" => ["http://www.ctrlaltdel-online.com/comic.php", qr'\d{8}\.jpg', "http://www.ctrlaltdel-online.com/comics/"],
"Foxtrot" => ["http://www.foxtrot.com", qr'http://images.ucomics.com/comics/ft/\d{4}/.+\.gif', ""],
"VGCats" => ["http://www.vgcats.com/comics/", qr'images/\d{6}\..{3}'],
"Dilbert" => ["http://www.dilbert.com/", qr'comics/dilbert/archive/images/dilbert\d+\.gif'],
"Bugbash" => ["http://www.bugbash.net/", qr'strips/.+gif'],
"My Extra Life" => ["http://www.myextralife.com/", qr'strips/.+\.jpg'],
"Dueling Analogs" => ["http://www.duelinganalogs.com/", qr'comics/.+\.png'],
"Little Gamers" => ["http://www.little-gamers.com/", qr'comics/\d{8}\.jpg'],
"Frank and Ernest" => ["http://www.comics.com/comics/franknernest/", qr'archive/images/frank.+(gif|jpg)'],
"Theater Hopper" => ["http://www.theaterhopper.com/", qr'vault/\d{6}\.jpg'],
"The Born Loser" => ["http://www.comics.com/comics/bornloser/", qr'archive.+bornloser\d+\.gif'],
"Working Daze" => ["http://www.comics.com/comics/workingdaze/", qr'archive/images/workingdaze\d+\.(jpg|gif)'],
);
my $xml_headers = <<'XML';
<rss version="2.0">
<channel>
Comics
http://gnuvince.net/~vince/comics
<description>Comics</description>
<language>en-us</language>
<ttl>40</ttl>
XML
my $xml_footers = <<'XML';
</channel>
</rss>
XML
my $str_date = strftime("%a, %d %b %Y %T %Z", localtime);
sub get_strip_url {
my ($url, $regex, $base) = @_;
if (!defined $base) {
$base = $url;
}
my $src = get($url);
if ($src) {
my ($file_location) = $src =~ m{($regex)};
return $base . $file_location if $file_location;
}
return "Couldn't fetch strip!";
}
sub print_item {
my ($name, $link) = @_;
print <<XML;
<item>
$name
<category>$name</category>
<description><img src="$link"></description>
$link
$str_date
<guid>$link</guid>
</item>
XML
}
sub main {
# Print the RSS feed
print $xml_headers;
while (my ($name, $params_ref) = each %strip) {
my $link = get_strip_url(@$params_ref);
print_item($name, $link);
}
print $xml_footers;
}
main() if !caller;
1;
__END__
=head1 NAME
comics
=head1 DESCRIPTION
comics is a simple script that generates an RSS feed with the daily
strip of several web comics. comics depends on LWP::Simple which
can be installed from CPAN to fetch the data necessary to the
construction of the feed.
=head1 TODO
=over
=item *
Add a configuration file into which people can put the strips they want
=item *
Get more strips in
=back
=head1 AUTHOR
Vincent Foley-Bourgon, <vfoleybourgon at yahoo dot ca>
=head1 COPYRIGHT AND LICENSE
Copyright 2006 by Vincent Foley-Bourgon
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut |
[langage] Aidez-moi avec les threads
Répondre avec citation
arallel::UserAgent
sa peut ce mettre a foirer a tout bout de champs sans raison 
Partager