#!/usr/bin/perl -w
#
-# webcollage, Copyright (c) 1999-2001 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999-2002 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."
#
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation. No representations are made about the suitability of this
-# software for any purpose. It is provided "as is" without express or
+# 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':
my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.78 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
-my $copyright = "WebCollage $version, Copyright (c) 1999-2001" .
+my $version = q{ $Revision: 1.87 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $copyright = "WebCollage $version, Copyright (c) 1999-2002" .
" Jamie Zawinski <jwz\@jwz.org>\n" .
" http://www.jwz.org/xscreensaver/\n";
# 0, "hotbot", \&pick_from_hotbot_text,
);
-#@search_methods=(100, "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" .
+my @root_displayers = (
+ "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.altavista.com" => "AV_ALL=1", # request uncensored searches
"web.altavista.com" => "AV_ALL=1",
- # log in as "cpunks"
- "www.nytimes.com" => "NYT-S=104nv1sChNnnWAvTLGx6eiDhzQcbSoN" .
- "6zOMB7s0Qm8MlMaa8It.2/BlXTrpbBk" .
- "jinV68IcqxOvAABDyKdciIJ8O000",
+ # log in as "cipherpunk"
+ "www.nytimes.com" => 'NYT-S=18cHMIlJOn2Y1bu5xvEG3Ufuk6E1oJ.' .
+ 'FMxWaQV0igaB5Yi/Q/guDnLeoL.pe7i1oakSb' .
+ '/VqfdUdb2Uo27Vzt1jmPn3cpYRlTw9',
);
+# 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
# 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.
+ "hotlinkpics.com" => 1, # Porn site that has poisoned imagevista
+ # (I don't see how they did it, though!)
+ "alwayshotels.com" => 1, # Poisoned Lycos pretty heavily.
);
my $min_height = 50;
my $min_ratio = 1/5;
+my $min_gif_area = (120 * 120);
+
+
my $no_output_p = 0;
my $urls_only_p = 0;
$hdrs .= "Referer: $referer\r\n";
}
if ($cookie) {
- foreach (split(/\r?\n/, $cookie)) {
- $hdrs .= "Cookie: $_\r\n";
- }
+ my @cc = split(/\r?\n/, $cookie);
+ $hdrs .= "Cookie: " . join('; ', @cc) . "\r\n";
}
$hdrs .= "\r\n";
LOG ($verbose_http, " ==> $_");
}
print S $hdrs;
- my $http = <S>;
+ my $http = <S> || "";
$_ = $http;
s/[\r\n]+$//s;
next;
}
+ # skip GIFs with a small number of pixels -- those usually suck.
+ if ($width && $height &&
+ m/\.gif$/io &&
+ ($width * $height) < $min_gif_area) {
+ LOG ($verbose_filter, " skip small GIF $_ (${width}x$height)");
+ next;
+ }
+
+
my $url = $_;
if ($unique_urls{$url}) {
}
LOG ($verbose_filter,
- " image $url" .
+ " image $url" .
($width && $height ? " (${width}x${height})" : "") .
($was_inline ? " (inline)" : ""));
$_ = undef;
$body = undef;
+ @urls = depoison (@urls);
+
if ( $#urls < 0 ) {
LOG ($verbose_load, "no images on $base" . ($fsp ? " (frameset)" : ""));
return ();
}
- @urls = depoison (@urls);
-
# pick a random element of the table
my $i = int(rand($#urls+1));
$url = $urls[$i];
# returns a random word from the dictionary
#
sub random_word {
-
my $word = 0;
if (open (IN, "<$wordlist")) {
my $size = (stat(IN))[7];
}
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);
}
+sub url_quote {
+ my ($s) = @_;
+ $s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge;
+ return $s;
+}
+
+sub url_unquote {
+ my ($s) = @_;
+ $s =~ s/[+]/ /g;
+ $s =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
+ 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;
# - a list of URLs from the page that the search engine returned;
$search_count = $1;
} elsif ($body =~ m@About ((\d{1,3})(,\d{3})*) images@i) { # imagevista
$search_count = $1;
+ } elsif ($body =~ m@We found ((\d{1,3})(,\d{3})*|\d+) results@i) { # *vista
+ $search_count = $1;
+ } elsif ($body =~ m@ of about <B>((\d{1,3})(,\d{3})*)<@i) { # googleimages
+ $search_count = $1;
+ } elsif ($body =~ m@<B>((\d{1,3})(,\d{3})*)</B> Web sites were found@i) {
+ $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
return;
}
- LOG ($verbose_load, "redirected to: $base");
+ LOG ($verbose_load, "redirected to: $base");
my $img = pick_image_from_body ($base, $body);
$body = undef;
"&mmW=1" . # unknown, but required
"&q=";
-
# imagevista
sub pick_from_alta_vista_images {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(1);
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);
+
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@[/.]doubleclick\.net\b@i); # you cretins
############################################################################
-my $alta_vista_url = "http://www.altavista.com/cgi-bin/query?pg=q" .
- "&text=yes&kl=XX&stype=stext&q=";
+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=";
+
+my $alta_vista_url = $alta_vista_url_2;
# altavista
sub pick_from_alta_vista_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(1);
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]+\&r=(.*)@);
- $u = $1;
+ 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);
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
sub pick_from_hotbot_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(0);
my $search_url = $hotbot_search_url . $words;
my ($search_hit_count, @subpages) =
sub pick_from_lycos_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(0);
my $start = int(rand(8)) * 10 + 1;
my $search_url = $lycos_search_url . $words . "&start=$start";
sub pick_from_yahoo_news_text {
my ( $timeout ) = @_;
- my $words = random_words;
+ my $words = random_words(1);
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;
# Picks a random image on a random page, and returns two URLs:
-# the page containing the image, and the image.
+# 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 error {
- ($_) = @_;
- print STDERR blurb() . "$_\n";
+ my ($err) = @_;
+ print STDERR blurb() . "$err\n";
exit 1;
}
# We must skip variables, since FFs in variable names aren't
# valid JPEG markers.
my $s = substr($body, $i, 2); $i += 2;
- my ($c1, $c2) = unpack ("C"x2, $s);
+ my ($c1, $c2) = unpack ("C"x2, $s);
my $length = ($c1 << 8) | $c2;
return () if ($length < 2);
$i += $length-2;
#
sub nontrapping_system {
$! = 0;
-
+
$_ = join(" ", @_);
s/\"[^\"]+\"/\"...\"/g;
# 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
+# PPM to the given output file. Returns the width/height of the image if
# successful.
#
sub image_to_pnm {
sub x_or_pbm_output {
+ # 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", "djpeg", "pnmpaste", "pnmscale", "pnmcut");
+ }
+
+ foreach (@progs) {
which ($_) || error "$_ not found on \$PATH.";
}
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 (defined ($webcollage_helper)) {
+
+ ($iw, $ih) = image_size ($body);
+ if (!$iw || !$ih) {
+ LOG (($verbose_pbm || $verbose_load),
+ "not a GIF or JPG" .
+ (($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);
my $target_h = $img_height;
my $cmd = "";
+ my $scale = 1.0;
# Usually scale the image to fit on the screen -- but sometimes scale it
# scale it to fit, we instead cut it in half until it fits -- that should
# give 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; }
+ if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
+ if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
if ($iw > $target_w || $ih > $target_h) {
while ($iw > $target_w ||
}
if (rand() < $crop_chance) {
-
+
my $ow = $crop_w;
my $oh = $crop_h;
-
+
if ($crop_w > $min_width) {
# if it's a banner, select the width linearly.
# otherwise, select a bell.
$crop_h = $min_height + int (bellrand() * ($crop_h - $min_height));
$crop_y = int (rand() * ($oh - $crop_h));
}
-
+
if ($crop_x != 0 || $crop_y != 0 ||
$crop_w != $iw || $crop_h != $ih) {
LOG ($verbose_pbm,
$y < 0 ||
$x + $crop_w > $img_width ||
$y + $crop_h > $img_height) {
-
+
LOG ($verbose_pbm,
"cropping for effective paste of ${crop_w}x$crop_h \@ $x,$y");
-
+
if ($x < 0) { $crop_x -= $x; $crop_w += $x; $x = 0; }
if ($y < 0) { $crop_y -= $y; $crop_h += $y; $y = 0; }
-
+
if ($x + $crop_w >= $img_width) { $crop_w = $img_width - $x - 1; }
if ($y + $crop_h >= $img_height) { $crop_h = $img_height - $y - 1; }
}
$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";
my $tsize = (stat($target))[7];
if ($tsize > 200) {
$cmd = "$ppm_to_root_window_cmd $target";
-
+
# xv seems to hate being killed. it tends to forget to clean
# up after itself, and leaves windows around and colors allocated.
# I had this same problem with vidwhacker, and I'm not entirely
# to do anyway.
#
$cmd .= " &";
-
+
$rc = nontrapping_system ($cmd);
-
+
if ($rc != 0) {
LOG (($verbose_pbm || $verbose_load), "display failed: \"$cmd\"");
return;
}
-
+
} else {
LOG ($verbose_pbm, "$target size is $tsize");
}
$http_proxy = shift @ARGV;
} elsif ($_ eq "-dictionary" || $_ eq "-dict") {
$dict = shift @ARGV;
+ } 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" .
projects / xscreensaver / blobdiff