#!/usr/bin/perl -w
#
-# webcollage, Copyright (c) 1999-2004 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999-2005 by Jamie Zawinski <jwz@jwz.org>
# This program decorates the screen with random images from the web.
# One satisfied customer described it as "a nonstop pop culture brainbath."
#
my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.117 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
-my $copyright = "WebCollage $version, Copyright (c) 1999-2004" .
+my $version = q{ $Revision: 1.127 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $copyright = "WebCollage $version, Copyright (c) 1999-2005" .
" Jamie Zawinski <jwz\@jwz.org>\n" .
" http://www.jwz.org/webcollage/\n";
-my @search_methods = ( 71, "altavista", \&pick_from_alta_vista_random_link,
- 10, "livejournal", \&pick_from_livejournal_images,
- 8, "yahoorand", \&pick_from_yahoo_random_link,
- 6, "yahoonews", \&pick_from_yahoo_news_text,
- 5, "ircimages", \&pick_from_ircimages,
+my @search_methods = ( 58, "altavista", \&pick_from_alta_vista_random_link,
+ 11, "livejournal", \&pick_from_livejournal_images,
+ 7, "yahoorand", \&pick_from_yahoo_random_link,
+ 10, "googlephotos", \&pick_from_google_image_photos,
+ 6, "googleimgs", \&pick_from_google_images,
+ 3, "googlenums", \&pick_from_google_image_numbers,
+ 5, "flickr", \&pick_from_flickr,
- # Alta Vista has a new "random link" URL now.
+ # In Apr 2002, Google asked me to stop searching them.
+ # I asked them to add a "random link" url. They said
+ # "that would be easy, we'll think about it" and then
+ # never wrote back. Booo Google! Booooo! So, screw
+ # those turkeys, I've turned Google searching back on.
+ # I'm sure they can take it. (Jan 2005.)
+
+ # Jan 2005: Yahoo fucked up their search form so that
+ # it's no longer possible to do "or" searches on news
+ # images, so we rarely get any hits there any more.
+ #
+ # 0, "yahoonews", \&pick_from_yahoo_news_text,
+
+ # Dec 2004: the ircimages guy's server can't take the
+ # heat, so he started banning the webcollage user agent.
+ # I tried to convince him to add a lighter-weight page to
+ # support webcollage better, but he doesn't care.
+ #
+ # 0, "ircimages", \&pick_from_ircimages,
+
+ # Dec 2002: Alta Vista has a new "random link" URL now.
# They added it specifically to better support webcollage!
# That was super cool of them. This is how we used to do
# it, before:
# 0, "avimages", \&pick_from_alta_vista_images,
# 0, "avtext", \&pick_from_alta_vista_text,
- # Google asked (nicely) for me to stop searching them.
- # I asked them to add a "random link" url. They said
- # "that would be easy, we'll think about it" and then
- # never wrote back. Booo Google! Booooo!
+ # This broke in 2004. Eh, Lycos sucks anyway.
#
- # 0, "googlenums", \&pick_from_google_image_numbers,
- # 0, "googleimgs", \&pick_from_google_images,
+ # 0, "lycos", \&pick_from_lycos_text,
- # I suspect Hotbot is actually the same search engine
- # data as Lycos.
+ # This broke in 2003, I think. I suspect Hotbot is
+ # actually the same search engine data as Lycos.
#
# 0, "hotbot", \&pick_from_hotbot_text,
-
- # Eh, Lycos sucks anyway.
- # 0, "lycos", \&pick_from_lycos_text,
);
# programs we can use to write to the root window (tried in ascending order.)
"www.geocities.com" => 1,
"www.angelfire.com" => 1,
"members.aol.com" => 1,
+ "img.photobucket.com" => 1,
+ "pics.livejournal.com" => 1,
+ "tinypic.com" => 1,
+ "flickr.com" => 1,
"yimg.com" => 1, # This is where dailynews.yahoo.com stores
"eimg.com" => 1, # its images, so pick_from_yahoo_news_text()
# hits this every time.
+ "images.quizfarm.com" => 1, # damn those LJ quizzes...
+ "images.quizilla.com" => 1,
+ "images.quizdiva.net" => 1,
+
"driftnet" => 1, # builtin...
);
+# For decoding HTML-encoded character entities to URLs.
+#
+my %entity_table = (
+ "apos" => '\'',
+ "quot" => '"', "amp" => '&', "lt" => '<', "gt" => '>',
+ "nbsp" => ' ', "iexcl" => '¡', "cent" => '¢', "pound" => '£',
+ "curren" => '¤', "yen" => '¥', "brvbar" => '¦', "sect" => '§',
+ "uml" => '¨', "copy" => '©', "ordf" => 'ª', "laquo" => '«',
+ "not" => '¬', "shy" => '', "reg" => '®', "macr" => '¯',
+ "deg" => '°', "plusmn" => '±', "sup2" => '²', "sup3" => '³',
+ "acute" => '´', "micro" => 'µ', "para" => '¶', "middot" => '·',
+ "cedil" => '¸', "sup1" => '¹', "ordm" => 'º', "raquo" => '»',
+ "frac14" => '¼', "frac12" => '½', "frac34" => '¾', "iquest" => '¿',
+ "Agrave" => 'À', "Aacute" => 'Á', "Acirc" => 'Â', "Atilde" => 'Ã',
+ "Auml" => 'Ä', "Aring" => 'Å', "AElig" => 'Æ', "Ccedil" => 'Ç',
+ "Egrave" => 'È', "Eacute" => 'É', "Ecirc" => 'Ê', "Euml" => 'Ë',
+ "Igrave" => 'Ì', "Iacute" => 'Í', "Icirc" => 'Î', "Iuml" => 'Ï',
+ "ETH" => 'Ð', "Ntilde" => 'Ñ', "Ograve" => 'Ò', "Oacute" => 'Ó',
+ "Ocirc" => 'Ô', "Otilde" => 'Õ', "Ouml" => 'Ö', "times" => '×',
+ "Oslash" => 'Ø', "Ugrave" => 'Ù', "Uacute" => 'Ú', "Ucirc" => 'Û',
+ "Uuml" => 'Ü', "Yacute" => 'Ý', "THORN" => 'Þ', "szlig" => 'ß',
+ "agrave" => 'à', "aacute" => 'á', "acirc" => 'â', "atilde" => 'ã',
+ "auml" => 'ä', "aring" => 'å', "aelig" => 'æ', "ccedil" => 'ç',
+ "egrave" => 'è', "eacute" => 'é', "ecirc" => 'ê', "euml" => 'ë',
+ "igrave" => 'ì', "iacute" => 'í', "icirc" => 'î', "iuml" => 'ï',
+ "eth" => 'ð', "ntilde" => 'ñ', "ograve" => 'ò', "oacute" => 'ó',
+ "ocirc" => 'ô', "otilde" => 'õ', "ouml" => 'ö', "divide" => '÷',
+ "oslash" => 'ø', "ugrave" => 'ù', "uacute" => 'ú', "ucirc" => 'û',
+ "uuml" => 'ü', "yacute" => 'ý', "thorn" => 'þ', "yuml" => 'ÿ',
+ "ndash" => '-', "mdash" => "--"
+);
+
+
##############################################################################
#
# Various global flags set by command line parameters, or computed
my $report_performance_interval = 60 * 15; # print some stats every 15 minutes
my $http_proxy = undef;
-my $http_timeout = 30;
+my $http_timeout = 20;
my $cvt_timeout = 10;
my $min_width = 50;
# returns three values: the HTTP response line; the document headers;
# and the document body.
#
-sub get_document_1 {
- my ( $url, $referer, $timeout ) = @_;
+sub get_document_1($$$) {
+ my ($url, $referer, $timeout) = @_;
if (!defined($timeout)) { $timeout = $http_timeout; }
if ($timeout > $http_timeout) { $timeout = $http_timeout; }
$url =~ m@^http://random\.yahoo\.com/@ ||
$url =~ m@^http://images\.google\.com/@) {
# block this, you turkeys.
- $user_agent = "Mozilla/4.76 [en] (X11; U; Linux 2.2.16-22 i686; Nav)";
+ $user_agent = "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.5)" .
+ " Gecko/20041111 Firefox/1.0";
}
my $hdrs = "GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" .
return ();
}
+ $SIG{ALRM} = 'DEFAULT'; # seem to be suffering a race?
return ( $http, $head, $body );
};
die if ($@ && $@ ne "alarm\n"); # propagate errors
+
+ if ($@ && $@ ne "alarm\n") {
+ print STDERR blurb() . "DIE " . join(" ", $@) . "\n";
+ die;
+ }
+
if ($@) {
# timed out
$head = undef;
# returns two values: the document headers; and the document body.
# if the given URL did a redirect, returns the redirected-to document.
#
-sub get_document {
- my ( $url, $referer, $timeout ) = @_;
+sub get_document($$;$) {
+ my ($url, $referer, $timeout) = @_;
my $start = time;
if (defined($referer) && $referer eq $driftnet_magic) {
# in again, but you have to present the old cookie to get the new cookie.
# So, by doing this, the built-in cypherpunks cookie will never go "stale".
#
-sub set_cookie {
+sub set_cookie($$) {
my ($host, $cookie) = @_;
my $oc = $cookies{$host};
return unless $oc;
# given a URL and the body text at that URL, selects and returns a random
# image from it. returns () if no suitable images found.
#
-sub pick_image_from_body {
- my ( $url, $body ) = @_;
+sub pick_image_from_body($$) {
+ my ($url, $body) = @_;
my $base = $url;
$_ = $url;
next;
}
+ # skip images with a URL that indicates a Yahoo thumbnail.
+ if (m@\.yimg\.com/.*/t/@) {
+ if (!$width) { $width = "?"; }
+ if (!$height) { $height = "?"; }
+ LOG ($verbose_filter, " skip yahoo thumb $_ (${width}x$height)");
+ next;
+ }
my $url = $_;
############################################################################
-sub pick_dictionary {
+sub pick_dictionary() {
my @dicts = ("/usr/dict/words",
"/usr/share/dict/words",
"/usr/share/lib/dict/words");
# returns a random word from the dictionary
#
-sub random_word {
- my $word = 0;
- if (open (IN, "<$wordlist")) {
- my $size = (stat(IN))[7];
- my $pos = rand $size;
- if (seek (IN, $pos, 0)) {
- $word = <IN>; # toss partial line
- $word = <IN>; # keep next line
- }
- if (!$word) {
- seek( IN, 0, 0 );
- $word = <IN>;
- }
- close (IN);
- }
+sub random_word() {
+
+ local *IN;
+ if (! open (IN, "<$wordlist")) {
+ return undef;
+ }
- return 0 if (!$word);
+ my $size = (stat(IN))[7];
+ my $word = undef;
+ my $count = 0;
- $word =~ s/^[ \t\n\r]+//;
- $word =~ s/[ \t\n\r]+$//;
- $word =~ s/ys$/y/;
- $word =~ s/ally$//;
- $word =~ s/ly$//;
- $word =~ s/ies$/y/;
- $word =~ s/ally$/al/;
- $word =~ s/izes$/ize/;
- $word =~ tr/A-Z/a-z/;
+ while (1) {
+ error ("looping ($count) while reading $wordlist")
+ if (++$count > 100);
- if ( $word =~ s/[ \t\n\r]/\+/g ) { # convert intra-word spaces to "+".
- $word = "\%22$word\%22"; # And put quotes (%22) around it.
+ my $pos = int (rand ($size));
+ if (seek (IN, $pos, 0)) {
+ $word = <IN>; # toss partial line
+ $word = <IN>; # keep next line
}
- return $word;
+ next unless ($word);
+ next if ($word =~ m/^[-\']/);
+
+ $word = lc($word);
+ $word =~ s/^.*-//s;
+ $word =~ s/^[^a-z]+//s;
+ $word =~ s/[^a-z]+$//s;
+ $word =~ s/\'s$//s;
+ $word =~ s/ys$/y/s;
+ $word =~ s/ally$//s;
+ $word =~ s/ly$//s;
+ $word =~ s/ies$/y/s;
+ $word =~ s/ally$/al/s;
+ $word =~ s/izes$/ize/s;
+ $word =~ s/esses$/ess/s;
+ $word =~ s/(.{5})ing$/$1/s;
+
+ next if (length ($word) > 14);
+ last if ($word);
+ }
+
+ close (IN);
+
+ if ( $word =~ s/\s/\+/gs ) { # convert intra-word spaces to "+".
+ $word = "\%22$word\%22"; # And put quotes (%22) around it.
+ }
+
+ return $word;
}
-sub random_words {
+
+sub random_words($) {
my ($or_p) = @_;
my $sep = ($or_p ? "%20OR%20" : "%20");
return (random_word . $sep .
}
-sub url_quote {
+sub url_quote($) {
my ($s) = @_;
$s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge;
return $s;
}
-sub url_unquote {
+sub url_unquote($) {
my ($s) = @_;
$s =~ s/[+]/ /g;
$s =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
return $s;
}
-sub html_quote {
+sub html_quote($) {
my ($s) = @_;
$s =~ s/&/&/gi;
$s =~ s/</</gi;
return $s;
}
-sub html_unquote {
+sub html_unquote($) {
my ($s) = @_;
- $s =~ s/</</gi; # far from exhaustive...
- $s =~ s/>/</gi;
- $s =~ s/"/\"/gi;
- $s =~ s/&/&/gi;
+ $s =~ s/(&([a-z]+);)/{ $entity_table{$2} || $1; }/gexi; # e.g., '
+ $s =~ s/(&\#(\d+);)/{ chr($2) }/gexi; # e.g., '
return $s;
}
# Note that this list contains all kinds of internal search engine
# junk URLs too -- caller must prune them.
#
-sub pick_from_search_engine {
+sub pick_from_search_engine($$$) {
my ( $timeout, $search_url, $words ) = @_;
$_ = $words;
}
-sub depoison {
+sub depoison(@) {
my (@urls) = @_;
my @urls2 = ();
foreach (@urls) {
# given a list of URLs, picks one at random; loads it; and returns a
# random image from it.
-# returns the url of the page loaded; the url of the image chosen;
-# and a debugging description string.
+# returns the url of the page loaded; the url of the image chosen.
#
-sub pick_image_from_pages {
+sub pick_image_from_pages($$$$@) {
my ($base, $total_hit_count, $unfiltered_link_count, $timeout, @pages) = @_;
$total_hit_count = "?" unless defined($total_hit_count);
# returns two URLs: the page containing the image, and the image.
# Returns () if nothing found this time.
#
-sub pick_from_yahoo_random_link {
- my ( $timeout ) = @_;
+sub pick_from_yahoo_random_link($) {
+ my ($timeout) = @_;
print STDERR "\n\n" if ($verbose_load);
LOG ($verbose_load, "URL: $yahoo_random_link");
# returns two URLs: the page containing the image, and the image.
# Returns () if nothing found this time.
#
-sub pick_from_alta_vista_random_link {
- my ( $timeout ) = @_;
+sub pick_from_alta_vista_random_link($) {
+ my ($timeout) = @_;
print STDERR "\n\n" if ($verbose_load);
LOG ($verbose_load, "URL: $alta_vista_random_link");
"&q=";
# avimages
-sub pick_from_alta_vista_images {
- my ( $timeout ) = @_;
+sub pick_from_alta_vista_images($) {
+ my ($timeout) = @_;
my $words = random_word();
my $page = (int(rand(9)) + 1);
"&q=";
# googleimgs
-sub pick_from_google_images {
- my ( $timeout ) = @_;
+sub pick_from_google_images($;$$) {
+ my ($timeout, $words, $max_page) = @_;
+
+ if (!defined($words)) {
+ $words = random_word; # only one word for Google
+ }
- my $words = random_word; # only one word for Google
my $page = (int(rand(9)) + 1);
my $num = 20; # 20 images per page
my $search_url = $google_images_url . $words;
pick_from_search_engine ($timeout, $search_url, $words);
my @candidates = ();
+ my %referers;
foreach my $u (@subpages) {
next unless ($u =~ m@imgres\?imgurl@i); # All pics start with this
next if ($u =~ m@[/.]google\.com\b@i); # skip google builtins
if ($u =~ m@^/imgres\?imgurl=(.*?)\&imgrefurl=(.*?)\&@) {
- my $urlf = $2;
- LOG ($verbose_filter, " candidate: $urlf");
- push @candidates, $urlf;
+ my $ref = $2;
+ my $img = $1;
+ $img = "http://$img" unless ($img =~ m/^http:/i);
+
+ LOG ($verbose_filter, " candidate: $ref");
+ push @candidates, $img;
+ $referers{$img} = $ref;
}
}
- return pick_image_from_pages ($search_url, $search_hit_count, $#subpages+1,
- $timeout, @candidates);
+ @candidates = depoison (@candidates);
+ return () if ($#candidates < 0);
+ my $i = int(rand($#candidates+1));
+ my $img = $candidates[$i];
+ my $ref = $referers{$img};
+
+ LOG ($verbose_load, "picked image " . ($i+1) . ": $img (on $ref)");
+ return ($ref, $img);
}
\f
############################################################################
#
-# Pick images by feeding random *numbers* into Google Image Search.
+# Pick images by feeding random numbers into Google Image Search.
# By jwz, suggested by Ian O'Donnell.
#
############################################################################
# googlenums
-sub pick_from_google_image_numbers {
- my ( $timeout ) = @_;
+sub pick_from_google_image_numbers($) {
+ my ($timeout) = @_;
my $max = 9999;
my $number = int(rand($max));
$number = sprintf("%04d", $number)
if (rand() < 0.3);
- my $words = "$number";
- my $page = (int(rand(40)) + 1);
- my $num = 20; # 20 images per page
- my $search_url = $google_images_url . $words;
-
- if ($page > 1) {
- $search_url .= "&start=" . $page*$num; # page number
- $search_url .= "&num=" . $num; #images per page
- }
-
- my ($search_hit_count, @subpages) =
- pick_from_search_engine ($timeout, $search_url, $words);
-
- my @candidates = ();
- my %referers;
- foreach my $u (@subpages) {
- next unless ($u =~ m@imgres\?imgurl@i); # All pics start with this
- next if ($u =~ m@[/.]google\.com\b@i); # skip google builtins
-
- if ($u =~ m@^/imgres\?imgurl=(.*?)\&imgrefurl=(.*?)\&@) {
- my $ref = $2;
- my $img = $1;
- $img = "http://$img" unless ($img =~ m/^http:/i);
+ pick_from_google_images ($timeout, "$number");
+}
- LOG ($verbose_filter, " candidate: $ref");
- push @candidates, $img;
- $referers{$img} = $ref;
- }
- }
- @candidates = depoison (@candidates);
- return () if ($#candidates < 0);
- my $i = int(rand($#candidates+1));
- my $img = $candidates[$i];
- my $ref = $referers{$img};
+\f
+############################################################################
+#
+# Pick images by feeding random digital camera file names into
+# Google Image Search.
+# By jwz, inspired by the excellent Random Personal Picture Finder
+# at http://www.diddly.com/random/
+#
+############################################################################
- LOG ($verbose_load, "picked image " . ($i+1) . ": $img (on $ref)");
- return ($ref, $img);
+my @photomakers = (
+ #
+ # Common digital camera file name formats, as described at
+ # http://www.diddly.com/random/about.html
+ #
+ sub { sprintf ("dcp%05d.jpg", int(rand(4000))); }, # Kodak
+ sub { sprintf ("dsc%05d.jpg", int(rand(4000))); }, # Nikon
+ sub { sprintf ("dscn%04d.jpg", int(rand(4000))); }, # Nikon
+ sub { sprintf ("mvc-%03d.jpg", int(rand(999))); }, # Sony Mavica
+ sub { sprintf ("mvc%05d.jpg", int(rand(9999))); }, # Sony Mavica
+ sub { sprintf ("P101%04d.jpg", int(rand(9999))); }, # Olympus w/ date=101
+ sub { sprintf ("P%x%02d%04d.jpg", # Olympus
+ int(rand(0xC)), int(rand(30))+1,
+ rand(9999)); },
+ sub { sprintf ("IMG_%03d.jpg", int(rand(999))); }, # ?
+ sub { sprintf ("IMAG%04d.jpg", int(rand(9999))); }, # RCA and Samsung
+ sub { my $n = int(rand(9999)); # Canon
+ sprintf ("1%02d-%04d.jpg", int($n/100), $n); },
+ sub { my $n = int(rand(9999)); # Canon
+ sprintf ("1%02d-%04d_IMG.jpg",
+ int($n/100), $n); },
+ sub { sprintf ("IMG_%04d.jpg", int(rand(9999))); }, # Canon
+ sub { sprintf ("dscf%04d.jpg", int(rand(9999))); }, # Fuji Finepix
+ sub { sprintf ("pdrm%04d.jpg", int(rand(9999))); }, # Toshiba PDR
+ sub { sprintf ("IM%06d.jpg", int(rand(9999))); }, # HP Photosmart
+ sub { sprintf ("EX%06d.jpg", int(rand(9999))); }, # HP Photosmart
+# sub { my $n = int(rand(3)); # Kodak DC-40,50,120
+# sprintf ("DC%04d%s.jpg", int(rand(9999)),
+# $n == 0 ? 'S' : $n == 1 ? 'M' : 'L'); },
+ sub { sprintf ("pict%04d.jpg", int(rand(9999))); }, # Minolta Dimage
+ sub { sprintf ("P%07d.jpg", int(rand(9999))); }, # Kodak DC290
+# sub { sprintf ("%02d%02d%04d.jpg", # Casio QV3000, QV4000
+# int(rand(12))+1, int(rand(31))+1,
+# int(rand(999))); },
+# sub { sprintf ("%02d%x%02d%04d.jpg", # Casio QV7000
+# int(rand(6)), # year
+# int(rand(12))+1, int(rand(31))+1,
+# int(rand(999))); },
+ sub { sprintf ("IMGP%04d.jpg", int(rand(9999))); }, # Pentax Optio S
+ sub { sprintf ("PANA%04d.jpg", int(rand(9999))); }, # Panasonic vid still
+ sub { sprintf ("HPIM%04d.jpg", int(rand(9999))); }, # HP Photosmart
+ sub { sprintf ("PCDV%04d.jpg", int(rand(9999))); }, # ?
+ );
+
+
+# googlephotos
+sub pick_from_google_image_photos($) {
+ my ($timeout) = @_;
+
+ my $i = int(rand($#photomakers + 1));
+ my $fn = $photomakers[$i];
+ my $file = &$fn;
+ my $words .= $file . "%20filetype:jpg";
+
+ pick_from_google_images ($timeout, $words);
}
"&aqo=";
# avtext
-sub pick_from_alta_vista_text {
- my ( $timeout ) = @_;
+sub pick_from_alta_vista_text($) {
+ my ($timeout) = @_;
my $words = random_words(0);
my $page = (int(rand(9)) + 1);
"&cobrand=undefined" .
"&query=");
-sub pick_from_hotbot_text {
- my ( $timeout ) = @_;
+sub pick_from_hotbot_text($) {
+ my ($timeout) = @_;
$last_search = $hotbot_search_url; # for warnings
"&tab=web" .
"&query=";
-sub pick_from_lycos_text {
- my ( $timeout ) = @_;
+sub pick_from_lycos_text($) {
+ my ($timeout) = @_;
$last_search = $lycos_search_url; # for warnings
#
############################################################################
-my $yahoo_news_url = "http://search.news.yahoo.com/search/news" .
- "?a=1" .
- "&c=news_photos" .
- "&s=-%24s%2C-date" .
- "&n=100" .
- "&o=o" .
- "&2=" .
- "&3=" .
+my $yahoo_news_url = "http://news.search.yahoo.com/search/news" .
+ "?c=news_photos" .
"&p=";
# yahoonews
-sub pick_from_yahoo_news_text {
- my ( $timeout ) = @_;
+sub pick_from_yahoo_news_text($) {
+ my ($timeout) = @_;
$last_search = $yahoo_news_url; # for warnings
- my $words = random_words(0);
+ my $words = random_word();
my $search_url = $yahoo_news_url . $words;
my ($search_hit_count, @subpages) =
my @candidates = ();
foreach my $u (@subpages) {
+
+ # de-redirectize the URLs
+ $u =~ s@^http://rds\.yahoo\.com/.*-http%3A@http:@s;
+
# only accept URLs on Yahoo's news site
next unless ($u =~ m@^http://dailynews\.yahoo\.com/@i ||
$u =~ m@^http://story\.news\.yahoo\.com/@i);
+ next unless ($u =~ m@&u=/@);
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
my $livejournal_img_url = "http://www.livejournal.com/stats/latest-img.bml";
+# With most of our image sources, we get a random page and then select
+# from the images on it. However, in the case of LiveJournal, the page
+# of images tends to update slowly; so we'll remember the last N entries
+# on it and randomly select from those, to get a wider variety each time.
+
+my $lj_cache_size = 1000;
+my @lj_cache = (); # fifo, for ordering by age
+my %lj_cache = (); # hash, for detecting dups
+
# livejournal
-sub pick_from_livejournal_images {
- my ( $timeout ) = @_;
+sub pick_from_livejournal_images($) {
+ my ($timeout) = @_;
$last_search = $livejournal_img_url; # for warnings
my ( $base, $body ) = get_document ($livejournal_img_url, undef, $timeout);
return () unless $body;
- my @candidates = ();
-
$body =~ s/\n/ /gs;
$body =~ s/(<recent-image)\b/\n$1/gsi;
next unless (m/^<recent-image\b/);
next unless (m/\bIMG=[\'\"]([^\'\"]+)[\'\"]/si);
my $img = html_unquote ($1);
+
+ next if ($lj_cache{$img}); # already have it
+
next unless (m/\bURL=[\'\"]([^\'\"]+)[\'\"]/si);
my $page = html_unquote ($1);
my @pair = ($img, $page);
LOG ($verbose_filter, " candidate: $img");
- push @candidates, \@pair;
+ push @lj_cache, \@pair;
+ $lj_cache{$img} = \@pair;
}
- return () if ($#candidates == -1);
+ return () if ($#lj_cache == -1);
- my $i = int(rand($#candidates+1));
- my ($img, $page) = @{$candidates[$i]};
+ my $n = $#lj_cache+1;
+ my $i = int(rand($n));
+ my ($img, $page) = @{$lj_cache[$i]};
- LOG ($verbose_load, "picked image " .($i+1) . "/" . ($#candidates+1) .
- ": $img");
+ # delete this one from @lj_cache and from %lj_cache.
+ #
+ @lj_cache = ( @lj_cache[0 .. $i-1],
+ @lj_cache[$i+1 .. $#lj_cache] );
+ delete $lj_cache{$img};
+
+ # Keep the size of the cache under the limit by nuking older entries
+ #
+ while ($#lj_cache >= $lj_cache_size) {
+ my $pairP = shift @lj_cache;
+ my $img = $pairP->[0];
+ delete $lj_cache{$img};
+ }
+
+ LOG ($verbose_load, "picked image " .($i+1) . "/$n: $img");
return ($page, $img);
}
my $ircimages_url = "http://ircimages.com/";
# ircimages
-sub pick_from_ircimages {
- my ( $timeout ) = @_;
+sub pick_from_ircimages($) {
+ my ($timeout) = @_;
$last_search = $ircimages_url; # for warnings
return ($search_url, $img);
}
+\f
+############################################################################
+#
+# Pick images from Flickr's page of recently-posted photos.
+#
+############################################################################
+
+my $flickr_img_url = "http://www.flickr.com/photos/";
+
+# Like LiveJournal, the Flickr page of images tends to update slowly,
+# so remember the last N entries on it and randomly select from those.
+
+# I know that Flickr has an API (http://www.flickr.com/services/api/)
+# but it was easy enough to scrape the HTML, so I didn't bother exploring.
+
+my $flickr_cache_size = 1000;
+my @flickr_cache = (); # fifo, for ordering by age
+my %flickr_cache = (); # hash, for detecting dups
+
+
+# flickr
+sub pick_from_flickr($) {
+ my ($timeout) = @_;
+
+ my $start = 16 * int(rand(100));
+
+ $last_search = $flickr_img_url; # for warnings
+ $last_search .= "?start=$start" if ($start > 0);
+
+ my ( $base, $body ) = get_document ($last_search, undef, $timeout);
+ return () unless $body;
+
+ $body =~ s/[\r\n]/ /gs;
+ $body =~ s/(<a)\b/\n$1/gsi;
+
+ my $count = 0;
+ my $count2 = 0;
+ foreach (split (/\n/, $body)) {
+ my ($page, $thumb) = m@<A \s [^<>]* \b HREF=\"([^<>\"]+)\" [^<>]* > \s*
+ <IMG \s [^<>]* \b SRC=\"([^<>\"]+)\" @xsi;
+ next unless defined ($thumb);
+ $page = html_unquote ($page);
+ $thumb = html_unquote ($thumb);
+
+ next unless ($thumb =~ m@^http://photos\d*\.flickr\.com/@);
+
+ my $base = "http://www.flickr.com/";
+ $page =~ s@^/@$base@;
+ $thumb =~ s@^/@$base@;
+
+ my $img = $thumb;
+ $img =~ s/_[a-z](\.[a-z\d]+)$/$1/si; # take off "thumb" suffix
+
+ $count++;
+ next if ($flickr_cache{$img}); # already have it
+
+ my @pair = ($img, $page, $start);
+ LOG ($verbose_filter, " candidate: $img");
+ push @flickr_cache, \@pair;
+ $flickr_cache{$img} = \@pair;
+ $count2++;
+ }
+
+ return () if ($#flickr_cache == -1);
+
+ my $n = $#flickr_cache+1;
+ my $i = int(rand($n));
+ my ($img, $page) = @{$flickr_cache[$i]};
+
+ # delete this one from @flickr_cache and from %flickr_cache.
+ #
+ @flickr_cache = ( @flickr_cache[0 .. $i-1],
+ @flickr_cache[$i+1 .. $#flickr_cache] );
+ delete $flickr_cache{$img};
+
+ # Keep the size of the cache under the limit by nuking older entries
+ #
+ while ($#flickr_cache >= $flickr_cache_size) {
+ my $pairP = shift @flickr_cache;
+ my $img = $pairP->[0];
+ delete $flickr_cache{$img};
+ }
+
+ LOG ($verbose_load, "picked image " .($i+1) . "/$n: $img");
+
+ return ($page, $img);
+}
+
\f
############################################################################
#
############################################################################
# driftnet
-sub pick_from_driftnet {
- my ( $timeout ) = @_;
+sub pick_from_driftnet($) {
+ my ($timeout) = @_;
my $id = $driftnet_magic;
my $dir = $driftnet_dir;
}
-sub get_driftnet_file {
+sub get_driftnet_file($) {
my ($file) = @_;
error ("\$driftnet_dir unset?") unless ($driftnet_dir);
}
-sub spawn_driftnet {
+sub spawn_driftnet($) {
my ($cmd) = @_;
# make a directory to use.
# Returns () if nothing found this time.
#
-sub pick_image {
- my ( $timeout ) = @_;
+sub pick_image(;$) {
+ my ($timeout) = @_;
$current_state = "select";
$load_method = "none";
#
############################################################################
-sub timestr {
+sub timestr() {
return strftime ("%H:%M:%S: ", localtime);
}
-sub blurb {
+sub blurb() {
return "$progname: " . timestr() . "$current_state: ";
}
-sub error {
+sub error($) {
my ($err) = @_;
print STDERR blurb() . "$err\n";
exit 1;
}
+sub stacktrace() {
+ my $i = 1;
+ print STDERR "$progname: stack trace:\n";
+ while (1) {
+ my ($package, $filename, $line, $subroutine) = caller($i++);
+ last unless defined($package);
+ $filename =~ s@^.*/@@;
+ print STDERR " $filename#$line, $subroutine\n";
+ }
+}
+
my $lastlog = "";
-sub clearlog {
+sub clearlog() {
$lastlog = "";
}
-sub showlog {
+sub showlog() {
my $head = "$progname: DEBUG: ";
foreach (split (/\n/, $lastlog)) {
print STDERR "$head$_\n";
$lastlog = "";
}
-sub LOG {
+sub LOG($$) {
my ($print, $msg) = @_;
my $blurb = timestr() . "$current_state: ";
$lastlog .= "$blurb$msg\n";
my %stats_elapsed;
my $last_state = undef;
-sub record_attempt {
+sub record_attempt($) {
my ($name) = @_;
if ($last_state) {
$suppress_audit = 0;
}
-sub record_success {
+sub record_success($$$) {
my ($name, $url, $base) = @_;
if (defined($stats_successes{$name})) {
$stats_successes{$name}++;
}
-sub record_failure {
+sub record_failure($) {
my ($name) = @_;
return if $image_succeeded;
-sub stats_of {
+sub stats_of($) {
my ($name) = @_;
my $i = $stats_successes{$name};
my $j = $stats_attempts{$name};
my $current_start_time = 0;
-sub start_timer {
+sub start_timer($) {
my ($name) = @_;
$current_start_time = time;
}
}
-sub stop_timer {
+sub stop_timer($$) {
my ($name, $success) = @_;
$stats_elapsed{$name} += time - $current_start_time;
}
my $last_report_time = 0;
-sub report_performance {
+sub report_performance() {
return unless $verbose_warnings;
my @recent_images = ();
my @recent_sites = ();
-sub save_recent_url {
+sub save_recent_url($$) {
my ($url, $base) = @_;
return unless ($verbose_warnings);
# Does %-decoding.
#
-sub url_decode {
+sub url_decode($) {
($_) = @_;
tr/+/ /;
s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Given the raw body of a GIF document, returns the dimensions of the image.
#
-sub gif_size {
+sub gif_size($) {
my ($body) = @_;
my $type = substr($body, 0, 6);
my $s;
# Given the raw body of a JPEG document, returns the dimensions of the image.
#
-sub jpeg_size {
+sub jpeg_size($) {
my ($body) = @_;
my $i = 0;
my $L = length($body);
# Given the raw body of a PNG document, returns the dimensions of the image.
#
-sub png_size {
+sub png_size($) {
my ($body) = @_;
return () unless ($body =~ m/^\211PNG\r/);
my ($bits) = ($body =~ m/^.{12}(.{12})/s);
# Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions
# of the image.
#
-sub image_size {
+sub image_size($) {
my ($body) = @_;
my ($w, $h) = gif_size ($body);
if ($w && $h) { return ($w, $h); }
# returns the full path of the named program, or undef.
#
-sub which {
+sub which($) {
my ($prog) = @_;
foreach (split (/:/, $ENV{PATH})) {
if (-x "$_/$prog") {
# Like rand(), but chooses numbers with a bell curve distribution.
-sub bellrand {
+sub bellrand(;$) {
($_) = @_;
$_ = 1.0 unless defined($_);
$_ /= 3.0;
}
-sub exit_cleanup {
+sub exit_cleanup() {
x_cleanup();
+ print STDERR "$progname: exiting\n" if ($verbose_warnings);
if (@pids_to_kill) {
print STDERR blurb() . "killing: " . join(' ', @pids_to_kill) . "\n";
kill ('TERM', @pids_to_kill);
}
}
-sub signal_cleanup {
+sub signal_cleanup($) {
my ($sig) = @_;
print STDERR blurb() . (defined($sig)
? "caught signal $sig."
: "exiting.")
. "\n"
- if ($verbose_exec);
+ if ($verbose_exec || $verbose_warnings);
exit 1;
}
#
##############################################################################
-sub url_only_output {
+sub url_only_output() {
do {
my ($base, $img) = pick_image;
if ($img) {
##############################################################################
#
-# Running as an xscreensaver module
+# Running as an xscreensaver module, or as a web page imagemap
#
##############################################################################
my $delay = 2;
-sub x_cleanup {
+sub x_cleanup() {
unlink $image_ppm, $image_tmp1, $image_tmp2;
unlink $imagemap_html_tmp, $imagemap_jpg_tmp
if (defined ($imagemap_html_tmp));
# Like system, but prints status about exit codes, and kills this process
# with whatever signal killed the sub-process, if any.
#
-sub nontrapping_system {
+sub nontrapping_system(@) {
$! = 0;
$_ = join(" ", @_);
# writes a PPM to the given output file. Returns the width/height of the
# image if successful.
#
-sub image_to_pnm {
+sub image_to_pnm($$$) {
my ($url, $body, $output) = @_;
my ($cmd, $cmd2, $w, $h);
} else {
LOG (($verbose_pbm || $verbose_load),
"not a GIF, JPG, or PNG" .
- (($body =~ m@<(base|html|head|body|script|table|a href)>@i)
+ (($body =~ m@<(base|html|head|body|script|table|a href)\b@i)
? " (looks like HTML)" : "") .
": $url");
$suppress_audit = 1;
}
}
-sub pick_root_displayer {
+sub pick_root_displayer() {
my @names = ();
foreach my $cmd (@root_displayers) {
my $ppm_to_root_window_cmd = undef;
-sub x_or_pbm_output {
+sub x_or_pbm_output($) {
my ($window_id) = @_;
# Check for our helper program, to see whether we need to use PPM pipelines.
}
}
-sub paste_image {
+sub paste_image($$$$) {
my ($base, $img, $body, $source) = @_;
$current_state = "paste";
$source .= "-" . stats_of($source);
print STDOUT "image: ${iw}x${ih} @ $x,$y $base $source\n"
if ($verbose_imgmap);
-
if ($imagemap_base) {
update_imagemap ($base, $x, $y, $iw, $ih,
$image_ppm, $img_width, $img_height);
}
-sub update_imagemap {
+sub update_imagemap($$$$$$$$) {
my ($url, $x, $y, $w, $h, $image_ppm, $image_width, $image_height) = @_;
$current_state = "imagemap";
}
-sub init_signals {
+sub init_signals() {
$SIG{HUP} = \&signal_cleanup;
$SIG{INT} = \&signal_cleanup;
END { exit_cleanup(); }
-sub main {
+sub main() {
$| = 1;
srand(time ^ $$);
$http_proxy = shift @ARGV;
} elsif ($_ eq "-dictionary" || $_ eq "-dict") {
$dict = shift @ARGV;
+ } elsif ($_ eq "-opacity") {
+ $opacity = shift @ARGV;
+ error ("opacity must be between 0.0 and 1.0")
+ if ($opacity <= 0 || $opacity > 1);
} elsif ($_ eq "-driftnet" || $_ eq "--driftnet") {
@search_methods = ( 100, "driftnet", \&pick_from_driftnet );
if (! ($ARGV[0] =~ m/^-/)) {
}
}
-main;
+main();
exit (0);
projects / xscreensaver / blobdiff