-#!/usr/local/bin/perl5 -w
+#!/usr/bin/perl -w
#
-# webcollage, Copyright (c) 1999 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999, 2000 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."
#
require Time::Local;
require POSIX;
use Fcntl ':flock'; # import LOCK_* constants
+use POSIX qw(strftime);
-my $version = q{ $Revision: 1.42 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $version = q{ $Revision: 1.63 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
my $copyright = "WebCollage $version, Copyright (c) 1999" .
" Jamie Zawinski <jwz\@jwz.org>\n" .
" http://www.jwz.org/xscreensaver/\n";
"?mmdo=3" .
"&nbq=12" .
"&stype=simage" .
- "&oart=1" .
- "&obw=1" .
- "&oshape=0" .
+ "&iclr=1" .
+ "&ibw=1" .
+ "&iexc=1" .
"&what=web" .
"&q=";
my $image_randomizer_2 = "http://www.hotbot.com/?clickSrc=search" .
"&MT=";
my $image_randomizer_3 = "http://www.altavista.com/cgi-bin/query?pg=q" .
"&text=yes&kl=XX&stype=stext&q=";
+my $image_randomizer_4 = "http://search.news.yahoo.com/search/news_photos?" .
+ "&z=&n=100&o=o&2=&3=&p=";
# I guess Photopoint got wise to me, because now they are doing error
# checking on the user ("u=") and album ("a=") parameters. Oh well.
my $wordlist = "/usr/dict/words";
if (!-r $wordlist) {
- $wordlist = "/usr/share/lib/dict/words"; # irix
+ $wordlist = "/usr/share/dict/words"; # BSD
+}
+if (!-r $wordlist) {
+ $wordlist = "/usr/share/lib/dict/words"; # Irix
}
die "$wordlist doesn't exist!\n" unless (-r $wordlist);
"eggplant");
+sub blurb {
+ return "$progname: " . strftime ("%H:%M:%S: ", localtime);
+}
##############################################################################
if ($timeout > $http_timeout) { $timeout = $http_timeout; }
if ( $verbose > 3 ) {
- print STDERR "$progname: get_document_1 $url " .
+ print STDERR blurb() . "get_document_1 $url " .
($referer ? $referer : "") . "\n";
}
my($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
if (! ($url_proto && $url_proto =~ m/^http:$/i)) {
- if ($verbose) { print STDERR "$progname: not an HTTP URL: $url\n"; }
+ if ($verbose) { print STDERR blurb() . "not an HTTP URL: $url\n"; }
return ();
}
eval {
local $SIG{ALRM} = sub {
if ($verbose > 0) {
- print STDERR "$progname: timed out ($timeout) for $url\n";
+ print STDERR blurb() . "timed out ($timeout) for $url\n";
}
die "alarm\n"
};
$proto = getprotobyname('tcp');
if (!socket(S, PF_INET, SOCK_STREAM, $proto)) {
- print STDERR "$progname: socket: $!\n" if ($verbose);
+ print STDERR blurb() . "socket: $!\n" if ($verbose);
return;
}
if (!connect(S, $paddr)) {
- print STDERR "$progname: connect($serverstring): $!\n"
+ print STDERR blurb() . "connect($serverstring): $!\n"
if ($verbose);
return;
}
$cookie = "AV_ALL=1";
}
- print S ("GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\n" .
- "Host: $them\n" .
- "User-Agent: $progname/$version\n" .
- ($referer ? "Referer: $referer\n" : "") .
- ($cookie ? "Cookie: $cookie\n" : "") .
- "\n");
+ print S ("GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" .
+ "Host: $them\r\n" .
+ "User-Agent: $progname/$version\r\n" .
+ ($referer ? "Referer: $referer\r\n" : "") .
+ ($cookie ? "Cookie: $cookie\r\n" : "") .
+ "\r\n");
my $http = <S>;
while (<S>) {
close S;
if ( $verbose > 3 ) {
- print STDERR "$progname: ==> $http\n";
+ print STDERR blurb() . " ==> $http\n";
}
return ( $http, $head, $body );
$location =~ s/[\r\n]$//;
if ( $verbose > 3 ) {
- print STDERR "$progname: redirect from " .
+ print STDERR blurb() . "redirect from " .
"$url to $location\n";
}
$referer = $url;
if ($loop_count++ > $max_loop_count) {
if ( $verbose > 1 ) {
- print STDERR "$progname: too many redirects " .
+ print STDERR blurb() . "too many redirects " .
"($max_loop_count) from $orig_url\n";
}
$body = undef;
}
if ( $verbose > 3 ) {
- print STDERR "$progname: base is $base\n";
+ print STDERR blurb() . "base is $base\n";
}
}
if ($trip_count >= $#tripwire_words - 2) {
if ($verbose > 1) {
- print STDERR "$progname: there is probably a dictionary in" .
+ print STDERR blurb() . "there is probably a dictionary in" .
" \"$url\": rejecting.\n";
}
$rejected_urls{$url} = -1;
my $L = length($1);
if ($L > 1000) {
if ($verbose > 1) {
- print STDERR "$progname: keywords of" .
+ print STDERR blurb() . "keywords of" .
" length $L in $url: rejecting.\n";
}
$rejected_urls{$url} = $L;
$_ = undef;
return ();
} elsif ( $verbose > 2 ) {
- print STDERR "$progname: keywords of length $L" .
+ print STDERR blurb() . "keywords of length $L" .
" in $url (ok.)\n";
}
}
if ( $width && $width < $min_width) {
if ( $verbose > 2 ) {
if (!$height) { $height = "?"; }
- print STDERR "$progname: skip narrow image " .
+ print STDERR blurb() . "skip narrow image " .
"$_ (${width}x$height)\n";
}
next;
if ( $height && $height < $min_height) {
if ( $verbose > 2 ) {
if (!$width) { $width = "?"; }
- print STDERR "$progname: skip short image " .
+ print STDERR blurb() . "skip short image " .
"$_ (${width}x$height)\n";
}
next;
($width * $min_ratio ) > $height ) {
if ( $verbose > 2 ) {
if (!$height) { $height = "?"; }
- print STDERR "$progname: skip bad ratio " .
+ print STDERR blurb() . "skip bad ratio " .
"$_ (${width}x$height)\n";
}
next;
if ( $unique_urls{$url} ) {
if ( $verbose > 2 ) {
- print STDERR "$progname: skip duplicate image $_\n";
+ print STDERR blurb() . "skip duplicate image $_\n";
}
next;
}
if ( $verbose > 2 ) {
- print STDERR "$progname: got $url" .
+ print STDERR blurb() . "got $url" .
($width && $height ? " (${width}x${height})" : "") .
($was_inline ? " (inline)" : "") . "\n";
}
if ( $#urls == 0 ) {
if ( $verbose > 2 ) {
- print STDERR "$progname: no images on $base\n";
+ print STDERR blurb() . "no images on $base\n";
}
return ();
}
$url = $urls[$i];
if ( $verbose > 2 ) {
- print STDERR "$progname: picked $url\n";
+ print STDERR blurb() . "picked $url\n";
}
return $url;
$word = <IN>; # toss partial line
$word = <IN>; # keep next line
}
+ if (!$word) {
+ seek( IN, 0, 0 );
+ $word = <IN>;
+ }
close (IN);
}
$word =~ s/izes$/ize/;
$word =~ tr/A-Z/a-z/;
+ if ( $word =~ s/[ \t\n\r]/\+/g ) { # convert intra-word spaces to "+".
+ $word = "\%22$word\%22"; # And put quotes (%22) around it.
+ }
+
return $word;
}
my $search_url = ($which == 0 ? $image_randomizer_1 :
$which == 1 ? $image_randomizer_2 :
- $image_randomizer_3) .
+ $which == 2 ? $image_randomizer_3 :
+ $image_randomizer_4) .
$words;
# Pick a random search-result page instead of always taking the first.
}
if ( $verbose > 3 ) {
- $_ = $words; s/%20/ /g; print STDERR "$progname: search words: $_\n";
+ $_ = $words; s/%20/ /g; print STDERR blurb() . "search words: $_\n";
}
if ( $verbose > 3 ) {
$_ = $body;
- s/Result [Pp]ages:.*$//s; # trim off page footer
- s/^.*?IMAGE RESULTS//s; # trim off page header
+# s/Result [Pp]ages:.*$//s; # trim off page footer
+# s/^.*?IMAGE RESULTS//s; # trim off page header
+
+ s/Have you tried these resources.*//s; # let's try it again
s/[\r\n\t ]+/ /g;
next unless ($u =~ m@^http://@i); # skip non-http and relative urls.
- next if ($u =~ m@[/.]altavista\.com@i); # skip altavista builtins
- next if ($u =~ m@[/.]av\.com@i);
- next if ($u =~ m@[/.]virage\.com@i);
- next if ($u =~ m@[/.]photoloft\.com@i);
- next if ($u =~ m@[/.]shopping\.com@i);
- next if ($u =~ m@[/.]thetrip\.com@i);
- next if ($u =~ m@[/.]cmgi\.com@i);
- next if ($u =~ m@[/.]intelihealth\.com@i);
- next if ($u =~ m@[/.]wildweb\.com@i);
- next if ($u =~ m@[/.]digital\.com@i);
- next if ($u =~ m@[/.]doubleclick\.net@i);
+ next if ($u =~ m@[/.]altavista\.com\b@i); # skip altavista builtins
+ next if ($u =~ m@[/.]altavista\.[a-z]{2}\b@i); # altavista.fr, etc
+ next if ($u =~ m@[/.]av\.com\b@i);
+ next if ($u =~ m@[/.]virage\.com\b@i);
+ next if ($u =~ m@[/.]photoloft\.com\b@i);
+ next if ($u =~ m@[/.]shopping\.com\b@i);
+ next if ($u =~ m@[/.]thetrip\.com\b@i);
+ next if ($u =~ m@[/.]cmgi\.com\b@i);
+ next if ($u =~ m@[/.]intelihealth\.com\b@i);
+ next if ($u =~ m@[/.]wildweb\.com\b@i);
+ next if ($u =~ m@[/.]digital\.com\b@i);
+ next if ($u =~ m@[/.]doubleclick\.net\b@i);
+ next if ($u =~ m@[/.]freeim\.org\b@i);
+ next if ($u =~ m@[/.]clicktomarket\.com\b@i); # you cretins
+ next if ($u =~ m@[/.]teragram\.com\b@i);
+
+ # must lose this one for altavista, even though it loses images of
+ # every single customer of akamai. Oh well, those people have lots
+ # of money, and so their images are probably boring anyway.
+ next if ($u =~ m@[/.]akamai\.net@i);
if ($which == 0 && $u =~ m@[/.]corbis\.com@) {
- $skipped = 1;
+ $skipped = 1;
if ( $verbose > 3 ) {
- print STDERR "$progname: skipping corbis URL: $u\n";
+ print STDERR blurb() . "skipping corbis URL: $u\n";
+ }
+ next;
+
+ } elsif ($which == 3 &&
+ ($u =~ m@^http://[^/]+$@ || # no slashes
+ $u =~ m@/$@ || # ends in /
+ ! ($u =~ m@dailynews\.yahoo\.com@))) { # not dailynews
+# $skipped = 1;
+ if ( $verbose > 3 ) {
+ print STDERR blurb() . "skipping non-AP URL: $u\n";
}
next;
} elsif ( $rejected_urls{$u} ) {
if ( $verbose > 3 ) {
my $L = $rejected_urls{$u};
- print STDERR "$progname: pre-rejecting sub-page: $u\n";
+ print STDERR blurb() . "pre-rejecting sub-page: $u\n";
}
next;
} elsif ( $verbose > 3 ) {
- print STDERR "$progname: sub-page: $u\n";
+ print STDERR blurb() . "sub-page: $u\n";
}
$subpages[++$#subpages] = $u;
if ( $#subpages < 0 ) {
if (!$skipped && $verbose > 1) {
- print STDERR "$progname: found nothing on $base " .
+ print STDERR blurb() . "found nothing on $base " .
"($length bytes, $href_count links).\n";
}
$body = undef;
my $subpage = $subpages[$i];
if ( $verbose > 3 ) {
- print STDERR "$progname: picked page $subpage\n";
+ print STDERR blurb() . "picked page $subpage\n";
}
if ($img) {
return ($base2, $img,
($which == 0 ? "imagevista" :
- $which == 1 ? "hotbot" : "altavista") .
+ $which == 1 ? "hotbot" :
+ $which == 2 ? "altavista" :
+ "ap") .
"/$search_count");
} else {
return ();
sub pick_image {
my ( $timeout ) = @_;
-
my $r = int(rand(100));
+
my ($base, $img, $source, $total, $count);
if ($r < 20) {
$total = ++$total_1;
$count = ++$count_1 if $img;
+ } elsif ($r < 65) {
+ ($base, $img, $source) = pick_from_image_randomizer ($timeout, 3);
+ $total = ++$total_4;
+ $count = ++$count_4 if $img;
+
# } elsif ($r < 70) {
# ($base, $img, $source) = pick_from_photo_randomizer ($timeout);
# $total = ++$total_4;
sub x_cleanup {
my ($sig) = @_;
- if ($verbose > 0) { print STDERR "$progname: caught signal $sig.\n"; }
+ if ($verbose > 0) { print STDERR blurb() . "caught signal $sig.\n"; }
unlink $image_ppm, $image_tmp1, $image_tmp2;
exit 1;
}
if ($verbose > 1) {
$_ = join(" ", @_);
s/\"[^\"]+\"/\"...\"/g;
- print STDERR "$progname: executing \"$_\"\n";
+ print STDERR blurb() . "executing \"$_\"\n";
}
my $rc = system @_;
if ($rc == 0) {
if ($verbose > 1) {
- print STDERR "$progname: subproc exited normally.\n";
+ print STDERR blurb() . "subproc exited normally.\n";
}
} elsif (($rc & 0xff) == 0) {
$rc >>= 8;
if ($verbose) {
- print "$progname: subproc exited with status $rc.\n";
+ print blurb() . "subproc exited with status $rc.\n";
}
} else {
if ($rc & 0x80) {
if ($verbose) {
- print "$progname: subproc dumped core.\n";
+ print blurb() . "subproc dumped core.\n";
}
$rc &= ~0x80;
}
if ($verbose) {
- print "$progname: subproc died with signal $rc.\n";
+ print blurb() . "subproc died with signal $rc.\n";
}
# die that way ourselves.
kill $rc, $$;
$cmd2 = "exec $cmd"; # yes, this really is necessary. if we don't
# do this, the process doesn't die properly.
- if ($verbose == 0) {
+ if ($verbose <= 1) {
+ #
+ # We get a "giftopnm: got a 'Application Extension' extension"
+ # warning any time it's an animgif.
+ #
+ # Note that "giftopnm: EOF / read error on image data" is not
+ # always a fatal error -- sometimes the image looks fine anyway.
+ #
$cmd2 .= " 2>/dev/null";
}
local $SIG{ALRM} = sub {
if ($verbose > 0) {
- print STDERR "$progname: timed out ($cvt_timeout) for " .
+ print STDERR blurb() . "timed out ($cvt_timeout) for " .
"$cmd on \"$url\" in pid $pid\n";
}
kill ('TERM', $pid) if ($pid);
$body = undef;
close PIPE;
- if ($verbose > 3) { print STDERR "$progname: awaiting $pid\n"; }
+ if ($verbose > 3) { print STDERR blurb() . "awaiting $pid\n"; }
waitpid ($pid, 0);
- if ($verbose > 3) { print STDERR "$progname: $pid completed\n"; }
+ if ($verbose > 3) { print STDERR blurb() . "$pid completed\n"; }
my $size = (stat($output))[7];
if ($size < 5) {
if ($verbose) {
- print STDERR "$progname: $cmd on ${w}x$h \"$url\" failed" .
+ print STDERR blurb() . "$cmd on ${w}x$h \"$url\" failed" .
" ($size bytes)\n";
}
return ();
}
if ($verbose > 1) {
- print STDERR "$progname: created ${w}x$h $output ($cmd)\n";
+ print STDERR blurb() . "created ${w}x$h $output ($cmd)\n";
}
return ($w, $h);
} else {
- print STDERR "$progname: $cmd failed: $!\n";
+ print STDERR blurb() . "$cmd failed: $!\n";
return ();
}
};
# make sure the various programs we execute exist, right up front.
foreach ("ppmmake", "giftopnm", "djpeg", "pnmpaste", "pnmscale",
"pnmcut") {
- which ($_) || die "$progname: $_ not found on \$PATH.\n";
+ which ($_) || die blurb() . "$_ not found on \$PATH.\n";
}
if (which($win_cmd_1)) {
} elsif (which($win_cmd_3)) {
$ppm_to_root_window_cmd = $ppm_to_root_window_cmd_3;
} else {
- die "$progname: didn't find $win_cmd_1, $win_cmd_2, or $win_cmd_3 on \$PATH.\n";
+ die blurb() . "didn't find $win_cmd_1, $win_cmd_2, or $win_cmd_3 on \$PATH.\n";
}
$SIG{HUP} = \&x_cleanup;
if (!$img_width || !$img_height) {
$_ = "xdpyinfo";
- which ($_) || die "$progname: $_ not found on \$PATH.\n";
+ which ($_) || die blurb() . "$_ not found on \$PATH.\n";
$_ = `$_`;
($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /;
if (!defined($img_height)) {
- die "$progname: xdpyinfo failed.\n";
+ die blurb() . "xdpyinfo failed.\n";
}
}
$bgimage = $background;
} elsif (! $background =~ m@^[-a-z0-9 ]+$@i) {
- print STDERR "$progname: not a color or readable file: " .
+ print STDERR blurb() . "not a color or readable file: " .
"$background\n";
exit 1;
} else {
#
$_ = "ppmmake '$bgcolor' $img_width $img_height";
if ($verbose > 1) {
- print STDERR "$progname: creating base image: $_\n";
+ print STDERR blurb() . "creating base image: $_\n";
}
nontrapping_system "$_ > $image_ppm";
} elsif ((@_ = jpeg_size ($body))) {
($iw, $ih) = @_;
$cmd = "djpeg |";
- } elsif ($body =~ "^P\d\n(\d+) (\d+)\n") {
+ } elsif ($body =~ m/^P\d\n(\d+) (\d+)\n/) {
$iw = $1;
$ih = $2;
$cmd = "";
} else {
- die "$progname: $bgimage is not a GIF, JPEG, or PPM.\n";
+ die blurb() . "$bgimage is not a GIF, JPEG, or PPM.\n";
}
my $x = int (($img_width - $iw) / 2);
my $y = int (($img_height - $ih) / 2);
if ($verbose > 1) {
- print STDERR "$progname: pasting $bgimage (${iw}x$ih) into base ".
+ print STDERR blurb() . "pasting $bgimage (${iw}x$ih) into base ".
"image at $x,$y\n";
}
$body = undef;
close (IMG);
if ($verbose > 1) {
- print STDERR "$progname: subproc exited normally.\n";
+ print STDERR blurb() . "subproc exited normally.\n";
}
rename ($image_tmp1, $image_ppm) ||
die ("renaming $image_tmp1 to $image_ppm: $!\n");
my ($base, $img, $body, $source) = @_;
if ($verbose > 1) {
- print STDERR "$progname: got $img (" . length($body) . ")\n";
+ print STDERR blurb() . "got $img (" . length($body) . ")\n";
}
my ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
#
if ($filter_cmd) {
if ($verbose > 1) {
- print STDERR "$progname: running $filter_cmd\n";
+ print STDERR blurb() . "running $filter_cmd\n";
}
my $rc = nontrapping_system "($filter_cmd) < $image_tmp1 >$image_tmp2";
if ($rc != 0) {
if ($verbose) {
- print STDERR "$progname: failed command: \"$filter_cmd\"\n";
- print STDERR "$progname: failed url: \"$img\" (${ow}x$oh)\n";
+ print STDERR blurb() . "failed command: \"$filter_cmd\"\n";
+ print STDERR blurb() . "failed url: \"$img\" (${ow}x$oh)\n";
}
return;
}
}
if ($iw <= 10 || $ih <= 10) {
if ($verbose > 1) {
- print STDERR "$progname: scaling to ${iw}x$ih would " .
+ print STDERR blurb() . "scaling to ${iw}x$ih would " .
"have been bogus.\n";
}
return 0;
}
if ($verbose > 1) {
- print STDERR "$progname: scaling to ${iw}x$ih\n";
+ print STDERR blurb() . "scaling to ${iw}x$ih\n";
}
$cmd .= " | pnmscale -xsize $iw -ysize $ih";
}
if ($verbose > 2 && $crop_chance > 0.1) {
- print STDERR "$progname: crop chance: $crop_chance\n";
+ print STDERR blurb() . "crop chance: $crop_chance\n";
}
if (rand() < $crop_chance) {
if ($verbose > 1 &&
($crop_x != 0 || $crop_y != 0 ||
$crop_w != $iw || $crop_h != $ih)) {
- print STDERR "$progname: randomly cropping to " .
+ print STDERR blurb() . "randomly cropping to " .
"${crop_w}x$crop_h \@ $crop_x,$crop_y\n";
}
}
$y + $crop_h > $img_height) {
if ($verbose > 1) {
- print STDERR "$progname: cropping for effective paste of " .
+ print STDERR blurb() . "cropping for effective paste of " .
"${crop_w}x$crop_h \@ $x,$y\n";
}
$ih = $crop_h;
$cmd .= " | pnmcut $crop_x $crop_y $iw $ih";
if ($verbose > 1) {
- print STDERR "$progname: cropping to ${crop_w}x$crop_h \@ " .
+ print STDERR blurb() . "cropping to ${crop_w}x$crop_h \@ " .
"$crop_x,$crop_y\n";
}
}
if ($verbose > 1) {
- print STDERR "$progname: pasting ${iw}x$ih \@ $x,$y in $image_ppm\n";
+ print STDERR blurb() . "pasting ${iw}x$ih \@ $x,$y in $image_ppm\n";
}
$cmd .= " | pnmpaste - $x $y $image_ppm";
if ($rc != 0) {
if ($verbose) {
- print STDERR "$progname: failed command: \"$cmd\"\n";
- print STDERR "$progname: failed url: \"$img\" (${ow}x$oh)\n";
+ print STDERR blurb() . "failed command: \"$cmd\"\n";
+ print STDERR blurb() . "failed url: \"$img\" (${ow}x$oh)\n";
}
return;
}
$rc = nontrapping_system "($post_filter_cmd) < $image_ppm > $target";
if ($rc != 0) {
if ($verbose) {
- print STDERR "$progname: filter failed: " .
+ print STDERR blurb() . "filter failed: " .
"\"$post_filter_cmd\"\n";
}
return;
if ($rc != 0) {
if ($verbose) {
- print STDERR "$progname: display failed: \"$cmd\"\n";
+ print STDERR blurb() . "display failed: \"$cmd\"\n";
}
return;
}
} elsif ($verbose > 1) {
- print STDERR "$progname: $target size is $tsize\n";
+ print STDERR blurb() . "$target size is $tsize\n";
}
}
$img_width = $1;
$img_height = $2;
} else {
- die "$progname: argument to \"-size\" must be" .
+ die blurb() . "argument to \"-size\" must be" .
" of the form \"640x400\"\n";
}
} elsif ($_ eq "-proxy" || $_ eq "-http-proxy") {
if (!$root_p && !$no_output_p) {
die "$copyright" .
- "$progname: the -root argument is mandatory (for now.)\n";
+ blurb() . "the -root argument is mandatory (for now.)\n";
}
if (!$no_output_p && !$ENV{DISPLAY}) {
- die "$progname: \$DISPLAY is not set.\n";
+ die blurb() . "\$DISPLAY is not set.\n";
}
if ($urls_only_p) {
projects / xscreensaver / blobdiff