-#!/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.36 $ }; $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";
my $progname = $argv0; $progname =~ s@.*/@@g;
my $random_redirector = "http://random.yahoo.com/bin/ryl";
-my $image_randomizer_1 = "http://image.altavista.com/cgi-bin/avncgi" .
- "?do=3" .
- "&verb=n" .
- "&oshape=n" .
- "&oorder=" .
- "&ophoto=1&oart=1&ocolor=1&obw=1" .
+my $image_randomizer_1 = "http://www.altavista.com/query" .
+ "?mmdo=3" .
+ "&nbq=12" .
"&stype=simage" .
- "&oprem=0" .
- "&query=";
+ "&iclr=1" .
+ "&ibw=1" .
+ "&iexc=1" .
+ "&what=web" .
+ "&q=";
my $image_randomizer_2 = "http://www.hotbot.com/?clickSrc=search" .
"&submit=SEARCH&SM=SC&LG=any" .
"&AM0=MC&AT0=words&AW0=" .
"&MT=";
my $image_randomizer_3 = "http://www.altavista.com/cgi-bin/query?pg=q" .
"&text=yes&kl=XX&stype=stext&q=";
-my $photo_randomizer = "http://albums.photopoint.com/j/View?u=1&a=1&p=";
-my $photo_randomizer_lo = 10000001;
-my $photo_randomizer_hi = 12400000;
+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 $photo_randomizer = "http://albums.photopoint.com/j/View?u=1&a=1&p=";
+#my $photo_randomizer_lo = 10000001;
+#my $photo_randomizer_hi = 12400000;
my $image_ppm = ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp") . "/webcollage." . $$;
my $image_tmp1 = $image_ppm . "-1";
my $http_timeout = 30;
my $cvt_timeout = 10;
-# if we have xli, use it to write to the root window. else use xv.
-my $ppm_to_root_window_cmd_1 = "xli -quiet -onroot -center" .
+# programs we can use to write to the root window (tried in ascending order.)
+my $ppm_to_root_window_cmd_1 = "xloadimage -onroot -quiet %%PPM%%";
+my $ppm_to_root_window_cmd_2 = "xli -quiet -onroot -center" .
" -border black %%PPM%%";
-my $ppm_to_root_window_cmd_2 = "xv -root -rmode 5 -viewonly" .
+my $ppm_to_root_window_cmd_3 = "xv -root -rmode 5 -viewonly" .
" +noresetroot %%PPM%% -quit";
my $ppm_to_root_window_cmd = undef; # initialized by x_output()
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 ();
}
$paddr = sockaddr_in($port2, $iaddr);
+ my $head = "";
+ my $body = "";
+
@_ =
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>;
- my $head = "";
- my $body = "";
while (<S>) {
$head .= $_;
last if m@^[\r\n]@;
close S;
if ( $verbose > 3 ) {
- print STDERR "$progname: ==> $http\n";
+ print STDERR blurb() . " ==> $http\n";
}
return ( $http, $head, $body );
die if ($@ && $@ ne "alarm\n"); # propagate errors
if ($@) {
# timed out
+ $head = undef;
+ $body = undef;
return ();
} else {
# didn't
$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;
return ();
}
} elsif ( $http =~ m@HTTP/[0-9.]+ [4-9][0-9][0-9]@ ) {
# http errors -- return nothing.
+ $body = undef;
return ();
} else {
}
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;
+ $body = undef;
+ $_ = undef;
return ();
}
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;
+ $body = undef;
+ $_ = 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";
}
}
}
+ $_ = undef;
+ $body = undef;
+
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;
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.
}
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 ) {
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);
my $href_count = 0;
$_ = $body;
- s/[\r\n\t ]+/ /g;
- s/Result Pages:.*$//; # trim off page footer
+# 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;
s/(<A )/\n$1/gi;
foreach (split(/\n/)) {
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@[/.]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 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 "$progname: skipping corbis URL: $u\n";
+ 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;
+ $_ = undef;
return ();
}
my $subpage = $subpages[$i];
if ( $verbose > 3 ) {
- print STDERR "$progname: picked page $subpage\n";
+ print STDERR blurb() . "picked page $subpage\n";
}
+ $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 ();
# to an image. Returns two URLs, both of which are the URL of the image.
# Returns () if nothing found this time.
#
-sub pick_from_photo_randomizer {
- my ( $timeout ) = @_;
- my $n = ($photo_randomizer_lo +
- int(rand() * ($photo_randomizer_hi - $photo_randomizer_lo)));
- my $url = $photo_randomizer . $n;
- return ( $url, $url, "photopoint" );
-}
+#sub pick_from_photo_randomizer {
+# my ( $timeout ) = @_;
+# my $n = ($photo_randomizer_lo +
+# int(rand() * ($photo_randomizer_hi - $photo_randomizer_lo)));
+# my $url = $photo_randomizer . $n;
+# return ( $url, $url, "photopoint" );
+#}
# Picks a random image on a random page, and returns two URLs:
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 < 70) {
- ($base, $img, $source) = pick_from_photo_randomizer ($timeout);
- $total = ++$total_4;
- $count = ++$count_4 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;
+# $count = ++$count_4 if $img;
# } elsif ($r < 80) {
# # HotBot sucks: 98% of the time, it says "no pages match your
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);
$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"; }
+ 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 ();
}
};
die if ($@ && $@ ne "alarm\n"); # propagate errors
if ($@) {
# timed out
+ $body = undef;
return ();
} else {
# didn't
alarm 0;
+ $body = undef;
return @_;
}
}
my $win_cmd_1 = $ppm_to_root_window_cmd_1;
my $win_cmd_2 = $ppm_to_root_window_cmd_2;
+ my $win_cmd_3 = $ppm_to_root_window_cmd_3;
$win_cmd_1 =~ s/^([^ \t\r\n]+).*$/$1/;
$win_cmd_2 =~ s/^([^ \t\r\n]+).*$/$1/;
+ $win_cmd_3 =~ s/^([^ \t\r\n]+).*$/$1/;
# 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)) {
$ppm_to_root_window_cmd = $ppm_to_root_window_cmd_1;
} elsif (which($win_cmd_2)) {
$ppm_to_root_window_cmd = $ppm_to_root_window_cmd_2;
- } else {
- die "$progname: neither $win_cmd_1 nor $win_cmd_2 found on \$PATH.\n";
+ } elsif (which($win_cmd_3)) {
+ $ppm_to_root_window_cmd = $ppm_to_root_window_cmd_3;
+ } else {
+ 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 blurb() . "xdpyinfo failed.\n";
+ }
}
my $bgcolor = "#000000";
$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";
}
$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";
+ print STDERR blurb() . "subproc exited normally.\n";
}
rename ($image_tmp1, $image_ppm) ||
die ("renaming $image_tmp1 to $image_ppm: $!\n");
my ($headers, $body) = get_document ($img, $base);
if ($body) {
handle_image ($base, $img, $body, $source);
+ $body = undef;
}
}
unlink $image_tmp1, $image_tmp2;
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);
+ $body = undef;
return 0 unless ($iw && $ih);
my $ow = $iw; # used only for error messages
#
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 manditory (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