#!/usr/local/bin/perl5 -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."
#
use Fcntl ':flock'; # import LOCK_* constants
-my $version = q{ $Revision: 1.41 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $version = q{ $Revision: 1.60 $ }; $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);
$paddr = sockaddr_in($port2, $iaddr);
+ my $head = "";
+ my $body = "";
+
@_ =
eval {
local $SIG{ALRM} = sub {
$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>;
- my $head = "";
- my $body = "";
while (<S>) {
$head .= $_;
last if m@^[\r\n]@;
die if ($@ && $@ ne "alarm\n"); # propagate errors
if ($@) {
# timed out
+ $head = undef;
+ $body = undef;
return ();
} else {
# didn't
print STDERR "$progname: too many redirects " .
"($max_loop_count) from $orig_url\n";
}
+ $body = undef;
return ();
}
} elsif ( $http =~ m@HTTP/[0-9.]+ [4-9][0-9][0-9]@ ) {
# http errors -- return nothing.
+ $body = undef;
return ();
} else {
" \"$url\": rejecting.\n";
}
$rejected_urls{$url} = -1;
+ $body = undef;
+ $_ = undef;
return ();
}
" length $L in $url: rejecting.\n";
}
$rejected_urls{$url} = $L;
+ $body = undef;
+ $_ = undef;
return ();
} elsif ( $verbose > 2 ) {
print STDERR "$progname: keywords of length $L" .
}
}
+ $_ = undef;
+ $body = undef;
+
if ( $#urls == 0 ) {
if ( $verbose > 2 ) {
print STDERR "$progname: no images on $base\n";
my ( $base, $body ) = get_document ($random_redirector, undef, $timeout);
- return if (!$base || !$body);
+ if (!$base || !$body) {
+ $body = undef;
+ return;
+ }
my $img = pick_image_from_body ($base, $body);
+ $body = undef;
if ($img) {
return ($base, $img, "yahoo");
$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.
my ( $base, $body ) = get_document ($search_url, undef, $timeout);
if (defined ($timeout)) {
$timeout -= (time - $start);
- return () if ($timeout <= 0);
+ if ($timeout <= 0) {
+ $body = undef;
+ return ();
+ }
}
return () if (! $body);
$_ = $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";
}
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 "$progname: skipping non-AP URL: $u\n";
+ }
+ next;
+
} elsif ( $rejected_urls{$u} ) {
if ( $verbose > 3 ) {
my $L = $rejected_urls{$u};
print STDERR "$progname: found nothing on $base " .
"($length bytes, $href_count links).\n";
}
+ $body = undef;
+ $_ = undef;
return ();
}
}
+ $body = undef;
+ $_ = undef;
my ( $base2, $body2 ) = get_document ($subpage, $base, $timeout);
- return () if (!$base2 || !$body2);
+ if (!$base2 || !$body2) {
+ $body2 = undef;
+ return ();
+ }
my $img = pick_image_from_body ($base2, $body2);
+ $body2 = undef;
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;
$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";
}
}
kill ('TERM', $pid) if ($pid);
$timed_out = 1;
+ $body = undef;
};
if (($pid = open(PIPE, "| $cmd2 > $output"))) {
$timed_out = 0;
alarm $cvt_timeout;
print PIPE $body;
+ $body = undef;
close PIPE;
if ($verbose > 3) { print STDERR "$progname: awaiting $pid\n"; }
die if ($@ && $@ ne "alarm\n"); # propagate errors
if ($@) {
# timed out
+ $body = undef;
return ();
} else {
# didn't
alarm 0;
+ $body = undef;
return @_;
}
}
} 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 = "";
$cmd .= "pnmpaste - $x $y $image_ppm > $image_tmp1";
open (IMG, "| $cmd") || die ("running $cmd: $!\n");
print IMG $body;
+ $body = undef;
close (IMG);
if ($verbose > 1) {
print STDERR "$progname: subproc exited normally.\n";
my ($headers, $body) = get_document ($img, $base);
if ($body) {
handle_image ($base, $img, $body, $source);
+ $body = undef;
}
}
unlink $image_tmp1, $image_tmp2;
}
my ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
+ $body = undef;
return 0 unless ($iw && $ih);
my $ow = $iw; # used only for error messages
if (!$root_p && !$no_output_p) {
die "$copyright" .
- "$progname: the -root argument is manditory (for now.)\n";
+ "$progname: the -root argument is mandatory (for now.)\n";
}
if (!$no_output_p && !$ENV{DISPLAY}) {
projects / xscreensaver / blobdiff