#!/usr/bin/perl -w
#
-# webcollage, Copyright (c) 1999-2001 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999-2004 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."
#
# software for any purpose. It is provided "as is" without express or
# implied warranty.
+
# To run this as a display mode with xscreensaver, add this to `programs':
#
-# default-n: webcollage -root \n\
-# default-n: webcollage -root -filter 'vidwhacker -stdin -stdout' \n\
+# webcollage -root
+# webcollage -root -filter 'vidwhacker -stdin -stdout'
+#
+#
+# You can see this in action at http://www.jwz.org/webcollage/ --
+# it auto-reloads about once a minute. To make a page similar to
+# that on your own system, do this:
+#
+# webcollage -size '800x600' -imagemap $HOME/www/webcollage/index
+#
+#
+# If you have the "driftnet" program installed, webcollage can display a
+# collage of images sniffed off your local ethernet, instead of pulled out
+# of search engines: in that way, your screensaver can display the images
+# that your co-workers are downloading!
+#
+# Driftnet is available here: http://www.ex-parrot.com/~chris/driftnet/
+# Use it like so:
+#
+# webcollage -root -driftnet
+#
+# Driftnet is the Unix implementation of the MacOS "EtherPEG" program.
require 5;
use Fcntl ':flock'; # import LOCK_* constants
use POSIX qw(strftime);
+use bytes; # Larry can take Unicode and shove it up his ass sideways.
+ # Perl 5.8.0 causes us to start getting incomprehensible
+ # errors about UTF-8 all over the place without this.
+
my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.82 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
-my $copyright = "WebCollage $version, Copyright (c) 1999-2001" .
+my $version = q{ $Revision: 1.117 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $copyright = "WebCollage $version, Copyright (c) 1999-2004" .
" Jamie Zawinski <jwz\@jwz.org>\n" .
- " http://www.jwz.org/xscreensaver/\n";
-
-
-
-my @search_methods = ( 30, "imagevista", \&pick_from_alta_vista_images,
- 28, "altavista", \&pick_from_alta_vista_text,
- 18, "yahoorand", \&pick_from_yahoo_random_link,
- 14, "googleimgs", \&pick_from_google_images,
- 2, "yahoonews", \&pick_from_yahoo_news_text,
- 8, "lycos", \&pick_from_lycos_text,
-
- # Hotbot gives me "no matches" just about every time.
- # Then I try the same URL again, and it works. I guess
- # it caches searches, and webcollage always busts its
- # cache and time out? Or it just sucks.
- # 0, "hotbot", \&pick_from_hotbot_text,
+ " 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,
+
+ # 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!
+ #
+ # 0, "googlenums", \&pick_from_google_image_numbers,
+ # 0, "googleimgs", \&pick_from_google_images,
+
+ # 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,
);
-#@search_methods=(100, "googleimgs",\&pick_from_google_images);
-
# programs we can use to write to the root window (tried in ascending order.)
#
my @root_displayers = (
- "xloadimage -quiet -onroot -center -border black",
- "xli -quiet -onroot -center -border black",
- "xv -root -quit -viewonly +noresetroot -rmode 5" .
+ "xscreensaver-getimage -root -file",
+ "chbg -once -xscreensaver -max_size 100",
+ "xv -root -quit -viewonly +noresetroot -quick24 -rmode 5" .
" -rfg black -rbg black",
- "chbg -once -xscreensaver",
+ "xli -quiet -onroot -center -border black",
+ "xloadimage -quiet -onroot -center -border black",
# this lame program wasn't built with vroot.h:
# "xsri -scale -keep-aspect -center-horizontal -center-vertical",
"www.nytimes.com" => 'NYT-S=18cHMIlJOn2Y1bu5xvEG3Ufuk6E1oJ.' .
'FMxWaQV0igaB5Yi/Q/guDnLeoL.pe7i1oakSb' .
'/VqfdUdb2Uo27Vzt1jmPn3cpYRlTw9',
+
+ "ircimages.com" => 'disclaimer=1',
);
+# If this is set, it's a helper program to use for pasting images together:
+# this is a lot faster and more efficient than using PPM pipelines, which is
+# what we do if this program doesn't exist. (We check for "webcollage-helper"
+# on $PATH at startup, and set this variable appropriately.)
+#
+my $webcollage_helper = undef;
+
+
+# If we have the webcollage-helper program, then it will paste the images
+# together with transparency! 0.0 is invisible, 1.0 is totally opaque.
+#
+my $opacity = 0.85;
+
+
# Some sites have managed to poison the search engines. These are they.
# (We auto-detect sites that have poisoned the search engines via excessive
# keywords or dictionary words, but these are ones that slip through
#
my %poisoners = (
"die.net" => 1, # 'l33t h4ck3r d00dz.
- "genforum.genealogy.com" => 1, # Cluttering altavista with human names.
- "rootsweb.com" => 1, # Cluttering altavista with human names.
+ "genforum.genealogy.com" => 1, # Cluttering avtext with human names.
+ "rootsweb.com" => 1, # Cluttering avtext with human names.
"akamai.net" => 1, # Lots of sites have their images on Akamai.
- # But those are pretty much all banners.
+ "akamaitech.net" => 1, # But those are pretty much all banners.
# Since Akamai is super-expensive, let's
# go out on a limb and assume that all of
# their customers are rich-and-boring.
- "bartleby.com" => 1, # Dictionary, cluttering altavista.
- "encyclopedia.com" => 1, # Dictionary, cluttering altavista.
- "onlinedictionary.datasegment.com" => 1, # Dictionary, cluttering altavista.
+ "bartleby.com" => 1, # Dictionary, cluttering avtext.
+ "encyclopedia.com" => 1, # Dictionary, cluttering avtext.
+ "onlinedictionary.datasegment.com" => 1, # Dictionary, cluttering avtext.
+ "hotlinkpics.com" => 1, # Porn site that has poisoned avimages
+ # (I don't see how they did it, though!)
+ "alwayshotels.com" => 1, # Poisoned Lycos pretty heavily.
+ "nextag.com" => 1, # Poisoned Alta Vista real good.
);
"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.
+
+ "driftnet" => 1, # builtin...
);
my $no_output_p = 0;
my $urls_only_p = 0;
+my $imagemap_base = undef;
+
+my @pids_to_kill = (); # forked pids we should kill when we exit, if any.
+
+my $driftnet_magic = 'driftnet';
+my $driftnet_dir = undef;
+my $default_driftnet_cmd = "driftnet -a -m 100";
my $wordlist;
my ($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
$path = "" unless $path;
+ if (!$url_proto || !$serverstring) {
+ LOG (($verbose_net || $verbose_load), "unparsable URL: $url");
+ return ();
+ }
+
my ($them,$port) = split(/:/, $serverstring);
$port = 80 unless $port;
my $port2 = $port;
if ($http_proxy) {
$serverstring = $http_proxy if $http_proxy;
+ $serverstring =~ s@^[a-z]+://@@;
($them2,$port2) = split(/:/, $serverstring);
$port2 = 80 unless $port2;
}
my $cookie = $cookies{$them};
my $user_agent = "$progname/$version";
- if ($url =~ m@^http://www\.altavista\.com/@) {
+
+ if ($url =~ m@^http://www\.altavista\.com/@ ||
+ $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)";
}
LOG ($verbose_http, " ==> $_");
}
print S $hdrs;
- my $http = <S>;
+ my $http = <S> || "";
+
+ # Kludge: the Yahoo Random Link is now returning as its first
+ # line "Status: 301" instead of "HTTP/1.0 301 Found". Fix it...
+ #
+ $http =~ s@^Status:\s+(\d+)\b@HTTP/1.0 $1@i;
$_ = $http;
s/[\r\n]+$//s;
my ( $url, $referer, $timeout ) = @_;
my $start = time;
+ if (defined($referer) && $referer eq $driftnet_magic) {
+ return get_driftnet_file ($url);
+ }
+
my $orig_url = $url;
my $loop_count = 0;
my $max_loop_count = 4;
if ( $http =~ m@^HTTP/[0-9.]+ 30[123]@ ) {
$_ = $head;
+
my ( $location ) = m@^location:[ \t]*(.*)$@im;
if ( $location ) {
$location =~ s/[\r\n]$//;
# randomly from the set of images on the web. All the logic here for
# rejecting some images is really a set of heuristics for rejecting
# images that are not really images: for rejecting *text* that is in
- # GIF/JPEG form. I don't want text, I want pictures, and I want the
- # content of the pictures to be randomly selected from among all the
- # available content.
+ # GIF/JPEG/PNG form. I don't want text, I want pictures, and I want
+ # the content of the pictures to be randomly selected from among all
+ # the available content.
#
# So, filtering out "dirty" pictures by looking for "dirty" keywords
# would be wrong: dirty pictures exist, like it or not, so webcollage
} elsif ( m/^(img|a) .*(src|href) ?= ?\"? ?(.*?)[ >\"]/io ) {
- my $was_inline = ( "$1" eq "a" || "$1" eq "A" );
+ my $was_inline = (! ( "$1" eq "a" || "$1" eq "A" ));
my $link = $3;
my ( $width ) = m/width ?=[ \"]*(\d+)/oi;
my ( $height ) = m/height ?=[ \"]*(\d+)/oi;
} elsif ( ! m@^[^/:?]+:@ ) {
$_ = "$base$link";
s@/\./@/@g;
- while (s@/\.\./@/@g) {
- }
+ 1 while (s@/[^/]+/\.\./@/@g);
}
# skip non-http
}
# skip non-image
- if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg)$@io ) {
+ if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg|png)$@io ) {
next;
}
$urls[++$#urls] = $url;
$unique_urls{$url}++;
- # jpegs are preferable to gifs.
+ # JPEGs are preferable to GIFs and PNGs.
$_ = $url;
- if ( ! m@[.]gif$@io ) {
+ if ( ! m@[.](gif|png)$@io ) {
$urls[++$#urls] = $url;
}
}
sub random_words {
- return (random_word . "%20" .
- random_word . "%20" .
- random_word . "%20" .
- random_word . "%20" .
+ my ($or_p) = @_;
+ my $sep = ($or_p ? "%20OR%20" : "%20");
+ return (random_word . $sep .
+ random_word . $sep .
+ random_word . $sep .
+ random_word . $sep .
random_word);
}
return $s;
}
+sub html_quote {
+ my ($s) = @_;
+ $s =~ s/&/&/gi;
+ $s =~ s/</</gi;
+ $s =~ s/>/>/gi;
+ $s =~ s/\"/"/gi;
+ return $s;
+}
+
+sub html_unquote {
+ my ($s) = @_;
+ $s =~ s/</</gi; # far from exhaustive...
+ $s =~ s/>/</gi;
+ $s =~ s/"/\"/gi;
+ $s =~ s/&/&/gi;
+ return $s;
+}
+
# Loads the given URL (a search on some search engine) and returns:
# - the total number of hits the search engine claimed it had;
$search_count = $1;
} elsif ($body =~ m@found about ((\d{1,3})(,\d{3})*|\d+) results@) {
$search_count = $1;
- } elsif ($body =~ m@\b\d+ - \d+ of (\d+)\b@i) { # imagevista
+ } elsif ($body =~ m@\b\d+ - \d+ of (\d+)\b@i) { # avimages
$search_count = $1;
- } elsif ($body =~ m@About ((\d{1,3})(,\d{3})*) images@i) { # imagevista
+ } elsif ($body =~ m@About ((\d{1,3})(,\d{3})*) images@i) { # avimages
$search_count = $1;
} elsif ($body =~ m@We found ((\d{1,3})(,\d{3})*|\d+) results@i) { # *vista
$search_count = $1;
$search_count = $1; # lycos
} elsif ($body =~ m@WEB.*?RESULTS.*?\b((\d{1,3})(,\d{3})*)\b.*?Matches@i) {
$search_count = $1; # hotbot
- } elsif ($body =~ m@no photos were found containing@i) { # imagevista
+ } elsif ($body =~ m@no photos were found containing@i) { # avimages
$search_count = "0";
- } elsif ($body =~ m@found no document matching@i) { # altavista
+ } elsif ($body =~ m@found no document matching@i) { # avtext
$search_count = "0";
}
1 while ($search_count =~ s/^(\d+)(\d{3})/$1,$2/);
############################################################################
# yahoorand
-my $yahoo_random_link = "http://random.yahoo.com/bin/ryl";
+my $yahoo_random_link = "http://random.yahoo.com/fast/ryl";
# Picks a random page; picks a random image on that page;
}
}
+\f
+############################################################################
+#
+# Pick images from random pages returned by the Alta Vista Random Link
+#
+############################################################################
+
+# altavista
+my $alta_vista_random_link = "http://www.altavista.com/image/randomlink";
+
+
+# Picks a random page; picks a random image on that page;
+# 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 ) = @_;
+
+ print STDERR "\n\n" if ($verbose_load);
+ LOG ($verbose_load, "URL: $alta_vista_random_link");
+
+ $last_search = $alta_vista_random_link; # for warnings
+
+ $suppress_audit = 1;
+
+ my ( $base, $body ) = get_document ($alta_vista_random_link,
+ undef, $timeout);
+ if (!$base || !$body) {
+ $body = undef;
+ return;
+ }
+
+ LOG ($verbose_load, "redirected to: $base");
+
+ my $img = pick_image_from_body ($base, $body);
+ $body = undef;
+
+ if ($img) {
+ return ($base, $img);
+ } else {
+ return ();
+ }
+}
+
\f
############################################################################
#
############################################################################
-my $alta_vista_images_url = "http://www.altavista.com/cgi-bin/query" .
+my $alta_vista_images_url = "http://www.altavista.com/image/results" .
"?ipht=1" . # photos
"&igrph=1" . # graphics
"&iclr=1" . # color
"&ibw=1" . # b&w
"&micat=1" . # no partner sites
- "&imgset=1" . # no partner sites
- "&stype=simage" . # do image search
- "&mmW=1" . # unknown, but required
+ "&sc=on" . # "site collapse"
"&q=";
-# imagevista
+# avimages
sub pick_from_alta_vista_images {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_word();
my $page = (int(rand(9)) + 1);
my $search_url = $alta_vista_images_url . $words;
my @candidates = ();
foreach my $u (@subpages) {
- # altavista is encoding their URLs now.
- next unless ($u =~
- m@^/r\?ck_sm=[a-zA-Z0-9]+\&ref=[a-zA-Z0-9]+(\&uid=[a-zA-Z0-9]+)?\&r=(.*)@);
- $u = url_unquote($2);
+ # avimages is encoding their URLs now.
+ next unless ($u =~ s/^.*\*\*(http%3a.*$)/$1/gsi);
+ $u = url_unquote($u);
next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs
next if ($u =~ m@[/.]altavista\.com\b@i); # skip altavista builtins
+ next if ($u =~ m@[/.]yahoo\.com\b@i); # yahoo and av in cahoots?
next if ($u =~ m@[/.]doubleclick\.net\b@i); # you cretins
next if ($u =~ m@[/.]clicktomarket\.com\b@i); # more cretins
\f
############################################################################
#
-# Pick images by feeding random words into Google Image Search
+# Pick images by feeding random words into Google Image Search.
# By Charles Gales <gales@us.ibm.com>
#
############################################################################
\f
############################################################################
#
-# Pick images by feeding random words into Alta Vista Text Search
+# Pick images by feeding random *numbers* into Google Image Search.
+# By jwz, suggested by Ian O'Donnell.
#
############################################################################
-my $alta_vista_url_1 = "http://www.altavista.com/cgi-bin/query?pg=q" .
- "&text=yes&kl=XX&stype=stext&q=";
-my $alta_vista_url_2 = "http://www.altavista.com/sites/search/web?pg=q" .
- "&kl=XX&search=Search&q=";
+# googlenums
+sub pick_from_google_image_numbers {
+ my ( $timeout ) = @_;
-my $alta_vista_url = $alta_vista_url_2;
+ my $max = 9999;
+ my $number = int(rand($max));
-# altavista
+ $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);
+
+ 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};
+
+ LOG ($verbose_load, "picked image " . ($i+1) . ": $img (on $ref)");
+ return ($ref, $img);
+}
+
+
+\f
+############################################################################
+#
+# Pick images by feeding random words into Alta Vista Text Search
+#
+############################################################################
+
+
+my $alta_vista_url = "http://www.altavista.com/web/results" .
+ "?pg=aq" .
+ "&aqmode=s" .
+ "&filetype=html" .
+ "&sc=on" . # "site collapse"
+ "&nbq=50" .
+ "&aqo=";
+
+# avtext
sub pick_from_alta_vista_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(0);
my $page = (int(rand(9)) + 1);
my $search_url = $alta_vista_url . $words;
# onMouseOver to make it look like they're not! Well, it makes it
# easier for us to identify search results...
#
- next unless ($u =~
- m@^/r\?ck_sm=[a-zA-Z0-9]+\&ref=[a-zA-Z0-9]+\&uid=[a-zA-Z0-9]+\&r=(.*)@);
- $u = url_unquote($1);
+ next unless ($u =~ s/^.*\*\*(http%3a.*$)/$1/gsi);
+ $u = url_unquote($u);
+
+ next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs
+ next if ($u =~ m@[/.]altavista\.com\b@i); # skip altavista builtins
+ next if ($u =~ m@[/.]yahoo\.com\b@i); # yahoo and av in cahoots?
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
#
############################################################################
-my $hotbot_search_url = "http://hotbot.lycos.com/" .
- "?SM=SC" .
- "&DV=0" .
- "&LG=any" .
- "&FVI=1" .
- "&DC=100" .
- "&DE=0" .
- "&SQ=1" .
- "&TR=13" .
- "&AM1=MC" .
- "&MT=";
+my $hotbot_search_url =("http://hotbot.lycos.com/default.asp" .
+ "?ca=w" .
+ "&descriptiontype=0" .
+ "&imagetoggle=1" .
+ "&matchmode=any" .
+ "&nummod=2" .
+ "&recordcount=50" .
+ "&sitegroup=1" .
+ "&stem=1" .
+ "&cobrand=undefined" .
+ "&query=");
sub pick_from_hotbot_text {
my ( $timeout ) = @_;
- my $words = random_words;
- my $search_url = $hotbot_search_url . $words;
+ $last_search = $hotbot_search_url; # for warnings
+
+ # lycos seems to always give us back dictionaries and word lists if
+ # we search for more than one word...
+ #
+ my $words = random_word();
+
+ my $start = int(rand(8)) * 10 + 1;
+ my $search_url = $hotbot_search_url . $words . "&first=$start&page=more";
my ($search_hit_count, @subpages) =
pick_from_search_engine ($timeout, $search_url, $words);
foreach my $u (@subpages) {
# Hotbot plays redirection games too
- next unless ($u =~ m@^/director.asp\?target=([^&]+)@);
- $u = url_decode($1);
+ # (not any more?)
+# next unless ($u =~ m@/director.asp\?.*\btarget=([^&]+)@);
+# $u = url_decode($1);
+
+ next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs
+ next if ($u =~ m@[/.]hotbot\.com\b@i); # skip hotbot builtins
+ next if ($u =~ m@[/.]lycos\.com\b@i); # skip hotbot builtins
+ next if ($u =~ m@[/.]inktomi\.com\b@i); # skip hotbot builtins
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
#
############################################################################
-my $lycos_search_url = "http://lycospro.lycos.com/srchpro/" .
+my $lycos_search_url = "http://search.lycos.com/default.asp" .
"?lpv=1" .
- "&t=any" .
+ "&loc=searchhp" .
+ "&tab=web" .
"&query=";
sub pick_from_lycos_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ $last_search = $lycos_search_url; # for warnings
+
+ # lycos seems to always give us back dictionaries and word lists if
+ # we search for more than one word...
+ #
+ my $words = random_word();
+
my $start = int(rand(8)) * 10 + 1;
- my $search_url = $lycos_search_url . $words . "&start=$start";
+ my $search_url = $lycos_search_url . $words . "&first=$start&page=more";
my ($search_hit_count, @subpages) =
pick_from_search_engine ($timeout, $search_url, $words);
my @candidates = ();
foreach my $u (@subpages) {
- # Lycos plays exact the same redirection game as hotbot.
- # Note that "id=0" is used for internal advertising links,
- # and 1+ are used for search results.
- next unless ($u =~ m@^http://click.hotbot.com/director.asp\?id=[1-9]\d*&target=([^&]+)@);
- $u = url_decode($1);
+ # Lycos plays redirection games.
+ # (not any more?)
+# next unless ($u =~ m@^http://click.lycos.com/director.asp
+# .*
+# \btarget=([^&]+)
+# .*
+# @x);
+# $u = url_decode($1);
+
+ next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs
+ next if ($u =~ m@[/.]hotbot\.com\b@i); # skip lycos builtins
+ next if ($u =~ m@[/.]lycos\.com\b@i); # skip lycos builtins
+ next if ($u =~ m@[/.]terralycos\.com\b@i); # skip lycos builtins
+ next if ($u =~ m@[/.]inktomi\.com\b@i); # skip lycos builtins
+
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
#
############################################################################
-my $yahoo_news_url = "http://search.news.yahoo.com/search/news_photos?" .
- "&z=&n=100&o=o&2=&3=&p=";
+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=" .
+ "&p=";
# yahoonews
sub pick_from_yahoo_news_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ $last_search = $yahoo_news_url; # for warnings
+
+ my $words = random_words(0);
my $search_url = $yahoo_news_url . $words;
my ($search_hit_count, @subpages) =
my @candidates = ();
foreach my $u (@subpages) {
# only accept URLs on Yahoo's news site
- next unless ($u =~ m@^http://dailynews.yahoo.com/@i);
+ next unless ($u =~ m@^http://dailynews\.yahoo\.com/@i ||
+ $u =~ m@^http://story\.news\.yahoo\.com/@i);
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
}
+\f
+############################################################################
+#
+# Pick images from LiveJournal's list of recently-posted images.
+#
+############################################################################
+
+my $livejournal_img_url = "http://www.livejournal.com/stats/latest-img.bml";
+
+# livejournal
+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;
+
+ foreach (split (/\n/, $body)) {
+ next unless (m/^<recent-image\b/);
+ next unless (m/\bIMG=[\'\"]([^\'\"]+)[\'\"]/si);
+ my $img = html_unquote ($1);
+ next unless (m/\bURL=[\'\"]([^\'\"]+)[\'\"]/si);
+ my $page = html_unquote ($1);
+ my @pair = ($img, $page);
+ LOG ($verbose_filter, " candidate: $img");
+ push @candidates, \@pair;
+ }
+
+ return () if ($#candidates == -1);
+
+ my $i = int(rand($#candidates+1));
+ my ($img, $page) = @{$candidates[$i]};
+
+ LOG ($verbose_load, "picked image " .($i+1) . "/" . ($#candidates+1) .
+ ": $img");
+
+ return ($page, $img);
+}
+
+\f
+############################################################################
+#
+# Pick images from ircimages.com (images that have been in the /topic of
+# various IRC channels.)
+#
+############################################################################
+
+my $ircimages_url = "http://ircimages.com/";
+
+# ircimages
+sub pick_from_ircimages {
+ my ( $timeout ) = @_;
+
+ $last_search = $ircimages_url; # for warnings
+
+ my $n = int(rand(2900));
+ my $search_url = $ircimages_url . "page-$n";
+
+ my ( $base, $body ) = get_document ($search_url, undef, $timeout);
+ return () unless $body;
+
+ my @candidates = ();
+
+ $body =~ s/\n/ /gs;
+ $body =~ s/(<A)\b/\n$1/gsi;
+
+ foreach (split (/\n/, $body)) {
+
+ my ($u) = m@<A\s.*\bHREF\s*=\s*([^>]+)>@i;
+ next unless $u;
+
+ if ($u =~ m/^\"([^\"]*)\"/) { $u = $1; } # quoted string
+ elsif ($u =~ m/^([^\s]*)\s/) { $u = $1; } # or token
+
+ next unless ($u =~ m/^http:/i);
+ next if ($u =~ m@^http://(searchirc\.com\|ircimages\.com)@i);
+ next unless ($u =~ m@[.](gif|jpg|jpeg|pjpg|pjpeg|png)$@i);
+
+ LOG ($verbose_http, " HREF: $u");
+ push @candidates, $u;
+ }
+
+ LOG ($verbose_filter, "" . $#candidates+1 . " links on $search_url");
+
+ return () if ($#candidates == -1);
+
+ my $i = int(rand($#candidates+1));
+ my $img = $candidates[$i];
+
+ LOG ($verbose_load, "picked image " .($i+1) . "/" . ($#candidates+1) .
+ ": $img");
+
+ $search_url = $img; # hmm...
+ return ($search_url, $img);
+}
+
+\f
+############################################################################
+#
+# Pick images by waiting for driftnet to populate a temp dir with files.
+# Requires driftnet version 0.1.5 or later.
+# (Driftnet is a program by Chris Lightfoot that sniffs your local ethernet
+# for images being downloaded by others.)
+# Driftnet/webcollage integration by jwz.
+#
+############################################################################
+
+# driftnet
+sub pick_from_driftnet {
+ my ( $timeout ) = @_;
+
+ my $id = $driftnet_magic;
+ my $dir = $driftnet_dir;
+ my $start = time;
+ my $now;
+
+ error ("\$driftnet_dir unset?") unless ($dir);
+ $dir =~ s@/+$@@;
+
+ error ("$dir unreadable") unless (-d "$dir/.");
+
+ $timeout = $http_timeout unless ($timeout);
+ $last_search = $id;
+
+ while ($now = time, $now < $start + $timeout) {
+ local *DIR;
+ opendir (DIR, $dir) || error ("$dir: $!");
+ while (my $file = readdir(DIR)) {
+ next if ($file =~ m/^\./);
+ $file = "$dir/$file";
+ closedir DIR;
+ LOG ($verbose_load, "picked file $file ($id)");
+ return ($id, $file);
+ }
+ closedir DIR;
+ }
+ LOG (($verbose_net || $verbose_load), "timed out for $id");
+ return ();
+}
+
+
+sub get_driftnet_file {
+ my ($file) = @_;
+
+ error ("\$driftnet_dir unset?") unless ($driftnet_dir);
+
+ my $id = $driftnet_magic;
+ my $re = qr/$driftnet_dir/;
+ error ("$id: $file not in $driftnet_dir?")
+ unless ($file =~ m@^$re@o);
+
+ local *IN;
+ open (IN, $file) || error ("$id: $file: $!");
+ my $body = '';
+ while (<IN>) { $body .= $_; }
+ close IN || error ("$id: $file: $!");
+ unlink ($file) || error ("$id: $file: rm: $!");
+ return ($id, $body);
+}
+
+
+sub spawn_driftnet {
+ my ($cmd) = @_;
+
+ # make a directory to use.
+ while (1) {
+ my $tmp = $ENV{TEMPDIR} || "/tmp";
+ $driftnet_dir = sprintf ("$tmp/driftcollage-%08x", rand(0xffffffff));
+ LOG ($verbose_exec, "mkdir $driftnet_dir");
+ last if mkdir ($driftnet_dir, 0700);
+ }
+
+ if (! ($cmd =~ m/\s/)) {
+ # if the command didn't have any arguments in it, then it must be just
+ # a pointer to the executable. Append the default args to it.
+ my $dargs = $default_driftnet_cmd;
+ $dargs =~ s/^[^\s]+//;
+ $cmd .= $dargs;
+ }
+
+ # point the driftnet command at our newly-minted private directory.
+ #
+ $cmd .= " -d $driftnet_dir";
+ $cmd .= ">/dev/null" unless ($verbose_exec);
+
+ my $pid = fork();
+ if ($pid < 0) { error ("fork: $!\n"); }
+ if ($pid) {
+ # parent fork
+ push @pids_to_kill, $pid;
+ LOG ($verbose_exec, "forked for \"$cmd\"");
+ } else {
+ # child fork
+ nontrapping_system ($cmd) || error ("exec: $!");
+ }
+
+ # wait a bit, then make sure the process actually started up.
+ #
+ sleep (1);
+ error ("pid $pid failed to start \"$cmd\"")
+ unless (1 == kill (0, $pid));
+}
\f
############################################################################
# Picks a random image on a random page, and returns two URLs:
# the page containing the image, and the image.
# Returns () if nothing found this time.
-# Uses the url-randomizer 1 time in 5, else the image randomizer.
#
sub pick_image {
$_ = $url;
my ($site) = m@^http://([^ \t\n\r/:]+)@;
+ return unless defined ($site);
+
+ if ($base eq $driftnet_magic) {
+ $site = $driftnet_magic;
+ @recent_images = ();
+ }
my $done = 0;
foreach (@recent_images) {
while (ord($ch) != 0xDA && $i < $L) {
# Find next marker, beginning with 0xFF.
while (ord($ch) != 0xFF) {
+ return () if (length($body) <= $i);
$ch = substr($body, $i, 1); $i++;
}
# markers can be padded with any number of 0xFF.
while (ord($ch) == 0xFF) {
+ return () if (length($body) <= $i);
$ch = substr($body, $i, 1); $i++;
}
($marker != 0xC4) &&
($marker != 0xCC)) { # it's a SOFn marker
$i += 3;
+ return () if (length($body) <= $i);
my $s = substr($body, $i, 4); $i += 4;
my ($a,$b,$c,$d) = unpack("C"x4, $s);
return (($c<<8|$d), ($a<<8|$b));
} else {
# We must skip variables, since FFs in variable names aren't
# valid JPEG markers.
+ return () if (length($body) <= $i);
my $s = substr($body, $i, 2); $i += 2;
my ($c1, $c2) = unpack ("C"x2, $s);
my $length = ($c1 << 8) | $c2;
return ();
}
-# Given the raw body of a GIF or JPEG document, returns the dimensions of
-# the image.
+# Given the raw body of a PNG document, returns the dimensions of the image.
+#
+sub png_size {
+ my ($body) = @_;
+ return () unless ($body =~ m/^\211PNG\r/);
+ my ($bits) = ($body =~ m/^.{12}(.{12})/s);
+ return () unless defined ($bits);
+ return () unless ($bits =~ /^IHDR/);
+ my ($ign, $w, $h) = unpack("a4N2", $bits);
+ return ($w, $h);
+}
+
+
+# Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions
+# of the image.
#
sub image_size {
my ($body) = @_;
my ($w, $h) = gif_size ($body);
if ($w && $h) { return ($w, $h); }
- return jpeg_size ($body);
+ ($w, $h) = jpeg_size ($body);
+ if ($w && $h) { return ($w, $h); }
+ return png_size ($body);
}
}
+sub exit_cleanup {
+ x_cleanup();
+ if (@pids_to_kill) {
+ print STDERR blurb() . "killing: " . join(' ', @pids_to_kill) . "\n";
+ kill ('TERM', @pids_to_kill);
+ }
+}
+
+sub signal_cleanup {
+ my ($sig) = @_;
+ print STDERR blurb() . (defined($sig)
+ ? "caught signal $sig."
+ : "exiting.")
+ . "\n"
+ if ($verbose_exec);
+ exit 1;
+}
+
+
+
##############################################################################
#
# Generating a list of urls only
#
##############################################################################
-my $image_ppm = ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp") . "/webcollage." . $$;
-my $image_tmp1 = $image_ppm . "-1";
-my $image_tmp2 = $image_ppm . "-2";
+my $image_ppm = sprintf ("%s/webcollage-%08x",
+ ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
+ rand(0xFFFFFFFF));
+my $image_tmp1 = sprintf ("%s/webcollage-1-%08x",
+ ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
+ rand(0xFFFFFFFF));
+my $image_tmp2 = sprintf ("%s/webcollage-2-%08x",
+ ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
+ rand(0xFFFFFFFF));
my $filter_cmd = undef;
my $post_filter_cmd = undef;
my $background = undef;
+my @imagemap_areas = ();
+my $imagemap_html_tmp = undef;
+my $imagemap_jpg_tmp = undef;
+
+
my $img_width; # size of the image being generated.
my $img_height;
-my $delay = 0;
-
+my $delay = 2;
sub x_cleanup {
- my ($sig) = @_;
- print STDERR blurb() . "caught signal $sig.\n" if ($verbose_exec);
unlink $image_ppm, $image_tmp1, $image_tmp2;
- exit 1;
+ unlink $imagemap_html_tmp, $imagemap_jpg_tmp
+ if (defined ($imagemap_html_tmp));
}
}
-# Given the URL of a GIF or JPEG image, and the body of that image, writes a
-# PPM to the given output file. Returns the width/height of the image if
-# successful.
+# Given the URL of a GIF, JPEG, or PNG image, and the body of that image,
+# writes a PPM to the given output file. Returns the width/height of the
+# image if successful.
#
sub image_to_pnm {
my ($url, $body, $output) = @_;
} elsif ((@_ = jpeg_size ($body))) {
($w, $h) = @_;
$cmd = "djpeg";
+ } elsif ((@_ = png_size ($body))) {
+ ($w, $h) = @_;
+ $cmd = "pngtopnm";
} else {
LOG (($verbose_pbm || $verbose_load),
- "not a GIF or JPG" .
+ "not a GIF, JPG, or PNG" .
(($body =~ m@<(base|html|head|body|script|table|a href)>@i)
? " (looks like HTML)" : "") .
": $url");
sub x_or_pbm_output {
+ my ($window_id) = @_;
+
+ # Check for our helper program, to see whether we need to use PPM pipelines.
+ #
+ $_ = "webcollage-helper";
+ if (defined ($webcollage_helper) || which ($_)) {
+ $webcollage_helper = $_ unless (defined($webcollage_helper));
+ LOG ($verbose_pbm, "found \"$webcollage_helper\"");
+ $webcollage_helper .= " -v";
+ } else {
+ LOG (($verbose_pbm || $verbose_load), "no $_ program");
+ }
# make sure the various programs we execute exist, right up front.
#
- foreach ("ppmmake", "giftopnm", "djpeg", "pnmpaste", "pnmscale", "pnmcut") {
+ my @progs = ("ppmmake"); # always need this one
+
+ if (!defined($webcollage_helper)) {
+ # Only need these others if we don't have the helper.
+ @progs = (@progs,
+ "giftopnm", "pngtopnm", "djpeg",
+ "pnmpaste", "pnmscale", "pnmcut");
+ }
+
+ foreach (@progs) {
which ($_) || error "$_ not found on \$PATH.";
}
#
$ppm_to_root_window_cmd = pick_root_displayer();
+ if (defined ($window_id)) {
+ error ("-window-id only works if xscreensaver-getimage is installed")
+ unless ($ppm_to_root_window_cmd =~ m/^xscreensaver-getimage\b/);
- $SIG{HUP} = \&x_cleanup;
- $SIG{INT} = \&x_cleanup;
- $SIG{QUIT} = \&x_cleanup;
- $SIG{ABRT} = \&x_cleanup;
- $SIG{KILL} = \&x_cleanup;
- $SIG{TERM} = \&x_cleanup;
-
- # Need this so that if giftopnm dies, we don't die.
- $SIG{PIPE} = 'IGNORE';
+ error ("unparsable window id: $window_id")
+ unless ($window_id =~ m/^\d+$|^0x[\da-f]+$/i);
+ $ppm_to_root_window_cmd =~ s/--?root\b/$window_id/ ||
+ error ("unable to munge displayer: $ppm_to_root_window_cmd");
+ }
if (!$img_width || !$img_height) {
- $_ = "xdpyinfo";
- which ($_) || error "$_ not found on \$PATH.";
- $_ = `$_`;
- ($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /;
- if (!defined($img_height)) {
- error "xdpyinfo failed.";
+
+ if (!defined ($window_id) &&
+ defined ($ENV{XSCREENSAVER_WINDOW})) {
+ $window_id = $ENV{XSCREENSAVER_WINDOW};
+ }
+
+ if (!defined ($window_id)) {
+ $_ = "xdpyinfo";
+ which ($_) || error "$_ not found on \$PATH.";
+ $_ = `$_`;
+ ($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /;
+ if (!defined($img_height)) {
+ error "xdpyinfo failed.";
+ }
+ } else { # we have a window id
+ $_ = "xwininfo";
+ which ($_) || error "$_ not found on \$PATH.";
+ $_ .= " -id $window_id";
+ $_ = `$_`;
+ ($img_width, $img_height) = m/^\s*Width:\s*(\d+)\n\s*Height:\s*(\d+)\n/m;
+
+ if (!defined($img_height)) {
+ error "xwininfo failed.";
+ }
}
}
($iw, $ih) = @_;
$cmd = "djpeg |";
+ } elsif ((@_ = png_size ($body))) {
+ ($iw, $ih) = @_;
+ $cmd = "pngtopnm |";
+
} elsif ($body =~ m/^P\d\n(\d+) (\d+)\n/) {
$iw = $1;
$ih = $2;
$cmd = "";
} else {
- error "$bgimage is not a GIF, JPEG, or PPM.";
+ error "$bgimage is not a GIF, JPEG, PNG, or PPM.";
}
my $x = int (($img_width - $iw) / 2);
LOG ($verbose_pbm, "got $img (" . length($body) . ")");
- my ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
- $body = undef;
- if (!$iw || !$ih) {
- LOG ($verbose_pbm, "unable to make PBM from $img");
- return 0;
+ my ($iw, $ih);
+
+ # If we are using the webcollage-helper, then we do not need to convert this
+ # image to a PPM. But, if we're using a filter command, we still must, since
+ # that's what the filters expect (webcollage-helper can read PPMs, so that's
+ # fine.)
+ #
+ if (defined ($webcollage_helper) &&
+ !defined ($filter_cmd)) {
+
+ ($iw, $ih) = image_size ($body);
+ if (!$iw || !$ih) {
+ LOG (($verbose_pbm || $verbose_load),
+ "not a GIF, JPG, or PNG" .
+ (($body =~ m@<(base|html|head|body|script|table|a href)>@i)
+ ? " (looks like HTML)" : "") .
+ ": $img");
+ $suppress_audit = 1;
+ $body = undef;
+ return 0;
+ }
+
+ local *OUT;
+ open (OUT, ">$image_tmp1") || error ("writing $image_tmp1: $!");
+ print OUT $body || error ("writing $image_tmp1: $!");
+ close OUT || error ("writing $image_tmp1: $!");
+
+ } else {
+ ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
+ $body = undef;
+ if (!$iw || !$ih) {
+ LOG ($verbose_pbm, "unable to make PBM from $img");
+ return 0;
+ }
}
record_success ($load_method, $img, $base);
return 0 unless ($iw && $ih);
}
- my $target_w = $img_width;
+ my $target_w = $img_width; # max rectangle into which the image must fit
my $target_h = $img_height;
my $cmd = "";
+ my $scale = 1.0;
# Usually scale the image to fit on the screen -- but sometimes scale it
- # to fit on half or a quarter of the screen. Note that we don't merely
- # scale it to fit, we instead cut it in half until it fits -- that should
- # give a wider distribution of sizes.
+ # to fit on half or a quarter of the screen. (We do this by reducing the
+ # size of the target rectangle.) Note that the image is not merely scaled
+ # to fit; we instead cut the image in half repeatedly until it fits in the
+ # target rectangle -- that gives a wider distribution of sizes.
#
- if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; }
+ if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; } # reduce target rect
if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; }
if ($iw > $target_w || $ih > $target_h) {
$ih > $target_h) {
$iw = int($iw / 2);
$ih = int($ih / 2);
+ $scale /= 2;
}
if ($iw <= 10 || $ih <= 10) {
LOG ($verbose_pbm, "scaling to ${iw}x$ih would have been bogus.");
return 0;
}
- LOG ($verbose_pbm, "scaling to ${iw}x$ih");
+ LOG ($verbose_pbm, "scaling to ${iw}x$ih ($scale)");
$cmd .= " | pnmscale -xsize $iw -ysize $ih";
}
# If any cropping needs to happen, add pnmcut.
#
if ($crop_x != 0 || $crop_y != 0 ||
- $crop_w != $iw || $crop_h != $ih) {
+ $crop_w != $iw || $crop_h != $ih) {
$iw = $crop_w;
$ih = $crop_h;
$cmd .= " | pnmcut $crop_x $crop_y $iw $ih";
$cmd =~ s@^ *\| *@@;
- $_ = "($cmd)";
- $_ .= " < $image_tmp1 > $image_tmp2";
+ if (defined ($webcollage_helper)) {
+ $cmd = "$webcollage_helper $image_tmp1 $image_ppm " .
+ "$scale $opacity " .
+ "$crop_x $crop_y $x $y " .
+ "$iw $ih";
+ $_ = $cmd;
+
+ } else {
+ # use a PPM pipeline
+ $_ = "($cmd)";
+ $_ .= " < $image_tmp1 > $image_tmp2";
+ }
if ($verbose_pbm) {
$_ = "($_) 2>&1 | sed s'/^/" . blurb() . "/'";
} else {
$_ .= " 2> /dev/null";
}
+
my $rc = nontrapping_system ($_);
+ if (defined ($webcollage_helper) && -z $image_ppm) {
+ LOG (1, "failed command: \"$cmd\"");
+ print STDERR "\naudit log:\n\n\n";
+ print STDERR ("#" x 78) . "\n";
+ print STDERR blurb() . "$image_ppm has zero size\n";
+ showlog();
+ print STDERR "\n\n";
+ exit (1);
+ }
+
if ($rc != 0) {
LOG (($verbose_pbm || $verbose_load), "failed command: \"$cmd\"");
LOG (($verbose_pbm || $verbose_load), "failed URL: \"$img\" (${ow}x$oh)");
return;
}
- rename ($image_tmp2, $image_ppm) || return;
+ if (!defined ($webcollage_helper)) {
+ rename ($image_tmp2, $image_ppm) || return;
+ }
my $target = "$image_ppm";
# cumulative.
#
if ($post_filter_cmd) {
+
+ my $cmd;
+
$target = $image_tmp1;
- $rc = nontrapping_system "($post_filter_cmd) < $image_ppm > $target";
+ if (!defined ($webcollage_helper)) {
+ $cmd = "($post_filter_cmd) < $image_ppm > $target";
+ } else {
+ # Blah, my scripts need the JPEG data, but some other folks need
+ # the PPM data -- what to do? Ignore the problem, that's what!
+# $cmd = "djpeg < $image_ppm | ($post_filter_cmd) > $target";
+ $cmd = "($post_filter_cmd) < $image_ppm > $target";
+ }
+
+ $rc = nontrapping_system ($cmd);
if ($rc != 0) {
LOG ($verbose_pbm, "filter failed: \"$post_filter_cmd\"\n");
return;
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);
+ }
+
clearlog();
return 1;
}
+sub update_imagemap {
+ my ($url, $x, $y, $w, $h, $image_ppm, $image_width, $image_height) = @_;
+
+ $current_state = "imagemap";
+
+ my $max_areas = 200;
+
+ $url = html_quote ($url);
+ my $x2 = $x + $w;
+ my $y2 = $y + $h;
+ my $area = "<AREA SHAPE=RECT COORDS=\"$x,$y,$x2,$y2\" HREF=\"$url\">";
+ unshift @imagemap_areas, $area; # put one on the front
+ if ($#imagemap_areas >= $max_areas) {
+ pop @imagemap_areas; # take one off the back.
+ }
+
+ LOG ($verbose_pbm, "area: $x,$y,$x2,$y2 (${w}x$h)");
+
+ my $map_name = $imagemap_base;
+ $map_name =~ s@^.*/@@;
+ $map_name = 'collage' if ($map_name eq '');
+
+ my $imagemap_html = $imagemap_base . ".html";
+ my $imagemap_jpg = $imagemap_base . ".jpg";
+
+ if (!defined ($imagemap_html_tmp)) {
+ $imagemap_html_tmp = $imagemap_html . sprintf (".%08x", rand(0xffffffff));
+ $imagemap_jpg_tmp = $imagemap_jpg . sprintf (".%08x", rand(0xffffffff));
+ }
+
+ # Read the imagemap html file (if any) to get a template.
+ #
+ my $template_html = '';
+ {
+ local *IN;
+ if (open (IN, "<$imagemap_html")) {
+ while (<IN>) { $template_html .= $_; }
+ close IN;
+ LOG ($verbose_pbm, "read template $imagemap_html");
+ }
+
+ if ($template_html =~ m/^\s*$/s) {
+ $template_html = ("<MAP NAME=\"$map_name\"></MAP>\n" .
+ "<IMG SRC=\"$imagemap_base.jpg\"" .
+ " USEMAP=\"$map_name\">\n");
+ LOG ($verbose_pbm, "created dummy template");
+ }
+ }
+
+ # Write the jpg to a tmp file
+ #
+ {
+ my $cmd;
+ if (defined ($webcollage_helper)) {
+ $cmd = "cp -p $image_ppm $imagemap_jpg_tmp";
+ } else {
+ $cmd = "cjpeg < $image_ppm > $imagemap_jpg_tmp";
+ }
+ my $rc = nontrapping_system ($cmd);
+ if ($rc != 0) {
+ error ("imagemap jpeg failed: \"$cmd\"\n");
+ }
+ }
+
+ # Write the html to a tmp file
+ #
+ {
+ my $body = $template_html;
+ my $areas = join ("\n\t", @imagemap_areas);
+ my $map = ("<MAP NAME=\"$map_name\">\n\t$areas\n</MAP>");
+ my $img = ("<IMG SRC=\"$imagemap_base.jpg\" " .
+ "BORDER=0 " .
+ "WIDTH=$image_width HEIGHT=$image_height " .
+ "USEMAP=\"#$map_name\">");
+ $body =~ s@(<MAP\s+NAME=\"[^\"]*\"\s*>).*?(</MAP>)@$map@is;
+ $body =~ s@<IMG\b[^<>]*\bUSEMAP\b[^<>]*>@$img@is;
+
+ # if there are magic webcollage spans in the html, update those too.
+ #
+ {
+ my @st = stat ($imagemap_jpg_tmp);
+ my $date = strftime("%d-%b-%Y %l:%M:%S %p %Z", localtime($st[9]));
+ my $size = int(($st[7] / 1024) + 0.5) . "K";
+ $body =~ s@(<SPAN\s+CLASS=\"webcollage_date\">).*?(</SPAN>)@$1$date$2@si;
+ $body =~ s@(<SPAN\s+CLASS=\"webcollage_size\">).*?(</SPAN>)@$1$size$2@si;
+ }
+
+ local *OUT;
+ open (OUT, ">$imagemap_html_tmp") || error ("$imagemap_html_tmp: $!");
+ print OUT $body || error ("$imagemap_html_tmp: $!");
+ close OUT || error ("$imagemap_html_tmp: $!");
+ LOG ($verbose_pbm, "wrote $imagemap_html_tmp");
+ }
+
+ # Rename the two tmp files to the real files
+ #
+ rename ($imagemap_html_tmp, $imagemap_html) ||
+ error "renaming $imagemap_html_tmp to $imagemap_html";
+ LOG ($verbose_pbm, "wrote $imagemap_html");
+ rename ($imagemap_jpg_tmp, $imagemap_jpg) ||
+ error "renaming $imagemap_jpg_tmp to $imagemap_jpg";
+ LOG ($verbose_pbm, "wrote $imagemap_jpg");
+}
+
+
+sub init_signals {
+
+ $SIG{HUP} = \&signal_cleanup;
+ $SIG{INT} = \&signal_cleanup;
+ $SIG{QUIT} = \&signal_cleanup;
+ $SIG{ABRT} = \&signal_cleanup;
+ $SIG{KILL} = \&signal_cleanup;
+ $SIG{TERM} = \&signal_cleanup;
+
+ # Need this so that if giftopnm dies, we don't die.
+ $SIG{PIPE} = 'IGNORE';
+}
+
+END { exit_cleanup(); }
+
+
sub main {
$| = 1;
srand(time ^ $$);
my $verbose = 0;
my $dict;
+ my $driftnet_cmd = 0;
$current_state = "init";
$load_method = "none";
my $root_p = 0;
+ my $window_id = undef;
# historical suckage: the environment variable name is lower case.
$http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY};
$ENV{DISPLAY} = shift @ARGV;
} elsif ($_ eq "-root") {
$root_p = 1;
+ } elsif ($_ eq "-window-id" || $_ eq "--window-id") {
+ $window_id = shift @ARGV;
+ $root_p = 1;
} elsif ($_ eq "-no-output") {
$no_output_p = 1;
} elsif ($_ eq "-urls-only") {
$urls_only_p = 1;
$no_output_p = 1;
+ } elsif ($_ eq "-imagemap") {
+ $imagemap_base = shift @ARGV;
+ $no_output_p = 1;
} elsif ($_ eq "-verbose") {
$verbose++;
} elsif (m/^-v+$/) {
$http_proxy = shift @ARGV;
} elsif ($_ eq "-dictionary" || $_ eq "-dict") {
$dict = shift @ARGV;
+ } elsif ($_ eq "-driftnet" || $_ eq "--driftnet") {
+ @search_methods = ( 100, "driftnet", \&pick_from_driftnet );
+ if (! ($ARGV[0] =~ m/^-/)) {
+ $driftnet_cmd = shift @ARGV;
+ } else {
+ $driftnet_cmd = $default_driftnet_cmd;
+ }
+ } elsif ($_ eq "-debug" || $_ eq "--debug") {
+ my $which = shift @ARGV;
+ my @rest = @search_methods;
+ my $ok = 0;
+ while (@rest) {
+ my $pct = shift @rest;
+ my $name = shift @rest;
+ my $tfn = shift @rest;
+
+ if ($name eq $which) {
+ @search_methods = (100, $name, $tfn);
+ $ok = 1;
+ last;
+ }
+ }
+ error "no such search method as \"$which\"" unless ($ok);
+ LOG (1, "DEBUG: using only \"$which\"");
+
} else {
- print STDERR "$copyright\nusage: $progname [-root]" .
- " [-display dpy] [-root] [-verbose] [-timeout secs]\n" .
- "\t\t [-delay secs] [-filter cmd] [-filter2 cmd]\n" .
- "\t\t [-dictionary dictionary-file]\n" .
- "\t\t [-http-proxy host[:port]]\n";
+ print STDERR "$copyright\nusage: $progname " .
+ "[-root] [-display dpy] [-verbose] [-debug which]\n" .
+ "\t\t [-timeout secs] [-delay secs] [-size WxH]\n" .
+ "\t\t [-no-output] [-urls-only] [-imagemap filename]\n" .
+ "\t\t [-filter cmd] [-filter2 cmd] [-background color]\n" .
+ "\t\t [-dictionary dictionary-file] [-http-proxy host[:port]]\n" .
+ "\t\t [-driftnet [driftnet-program-and-args]]\n" .
+ "\n";
exit 1;
}
}
pick_dictionary();
}
+ init_signals();
+
+ spawn_driftnet ($driftnet_cmd) if ($driftnet_cmd);
+
if ($urls_only_p) {
- url_only_output;
+ url_only_output ();
} else {
- x_or_pbm_output;
+ x_or_pbm_output ($window_id);
}
}
projects / xscreensaver / blobdiff