-#!/usr/local/bin/perl5 -w
+#!/usr/bin/perl -w
#
# webcollage, Copyright (c) 1999, 2000 by Jamie Zawinski <jwz@jwz.org>
# This program decorates the screen with random images from the web.
require Time::Local;
require POSIX;
use Fcntl ':flock'; # import LOCK_* constants
+use POSIX qw(strftime);
-my $version = q{ $Revision: 1.60 $ }; $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";
"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;
}
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;
}
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 ) {
if ($which == 0 && $u =~ m@[/.]corbis\.com@) {
$skipped = 1;
if ( $verbose > 3 ) {
- print STDERR "$progname: skipping corbis URL: $u\n";
+ print STDERR blurb() . "skipping corbis URL: $u\n";
}
next;
! ($u =~ m@dailynews\.yahoo\.com@))) { # not dailynews
# $skipped = 1;
if ( $verbose > 3 ) {
- print STDERR "$progname: skipping non-AP 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;
my $subpage = $subpages[$i];
if ( $verbose > 3 ) {
- print STDERR "$progname: picked page $subpage\n";
+ print STDERR blurb() . "picked page $subpage\n";
}
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, $$;
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";
$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