1 #!/usr/local/bin/perl5 -w
3 # webcollage, for xscreensaver, Copyright (c) 1999 Jamie Zawinski <jwz@jwz.org>
5 # Permission to use, copy, modify, distribute, and sell this software and its
6 # documentation for any purpose is hereby granted without fee, provided that
7 # the above copyright notice appear in all copies and that both that
8 # copyright notice and this permission notice appear in supporting
9 # documentation. No representations are made about the suitability of this
10 # software for any purpose. It is provided "as is" without express or
14 # This program decorate the screen with random images from the web.
22 $progname =~ s@^.*/([^/]+)$@$1@;
24 my $random_redirector = "http://random.yahoo.com/bin/ryl";
25 my $image_randomizer_a = "http://image.altavista.com/";
26 my $image_randomizer = $image_randomizer_a . "cgi-bin/avncgi" .
27 "?do=3&verb=no&oshape=n&oorder=" .
28 "&ophoto=1&oart=1&ocolor=1&obw=1" .
29 "&stype=simage&oprem=0&query=";
31 my $http_timeout = 30;
32 my $ppm_to_root_window_cmd = "xv -root -rmode 5 -viewonly" .
33 " +noresetroot %%PPM%% -quit";
34 my $filter_cmd = undef;
35 my $post_filter_cmd = undef;
36 my $background = undef;
40 my $wordlist = "/usr/dict/words";
43 $wordlist = "/usr/share/lib/dict/words"; # irix
53 # returns three values: the HTTP response line; the document headers;
54 # and the document body.
60 print STDERR "get_document_1 $url\n";
63 my($dummy, $dummy, $serverstring, $path) = split(/\//, $url, 4);
64 my($them,$port) = split(/:/, $serverstring);
65 $port = 80 unless $port;
68 my ($remote, $iaddr, $paddr, $proto, $line);
70 if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
72 $iaddr = inet_aton($remote) || return;
73 $paddr = sockaddr_in($port, $iaddr);
77 local $SIG{ALRM} = sub {
79 print STDERR "timed out for $url\n";
84 $proto = getprotobyname('tcp');
85 socket(S, PF_INET, SOCK_STREAM, $proto) || return;
86 connect(S, $paddr) || return;
88 select(S); $| = 1; select(STDOUT);
90 print S ("GET /$path HTTP/1.0\n" .
92 "User-Agent: $progname/$version\n" .
109 return ( $http, $head, $body );
111 die if ($@ && $@ ne "alarm\n"); # propagate errors
123 # returns two values: the document headers; and the document body.
124 # if the given URL did a redirect, returns the redirected-to document.
130 my ( $http, $head, $body ) = get_document_1 $url;
132 return undef if ( ! $body );
134 if ( $http =~ m@HTTP/[0-9.]+ 30[23]@ ) {
136 my ( $location ) = m@^location:[ \t]*(.*)$@im;
140 print STDERR "redirect from $url to $location\n";
144 return ( $url, $body );
147 } elsif ( $http =~ m@HTTP/[0-9.]+ [4-9][0-9][0-9]@ ) {
148 # http errors -- return nothing.
153 return ( $url, $body );
160 # given a URL and the body text at that URL, selects and returns a random
161 # image from it. returns undef if no suitable images found.
163 sub pick_image_from_body {
164 my ( $base, $body ) = @_;
168 # if there's at least one slash after the host, take off the last
170 if ( m@^http://[^/]+/@io ) {
171 ( $base = $base ) =~ s@[^/]+$@@go;
174 # if there are no slashes after the host at all, put one on the end.
175 if ( m@^http://[^/]+$@io ) {
180 print STDERR "base is $base\n";
186 # strip out newlines, compress whitespace
195 foreach (split(/ *</)) {
196 if ( m/^(img|a) .*(src|href) ?= ?\"? ?(.*?)[ >\"]/io ) {
198 my $was_inline = ( "$1" eq "a" || "$1" eq "A" );
200 my ( $width ) = m/width ?= ?([0-9]+)/oi;
201 my ( $height ) = m/height ?= ?([0-9]+)/oi;
206 ( $site = $base ) =~ s@^(http://[^/]*).*@$1@gio;
211 while (s@/\.\./@/@g) {
216 if ( ! m@^http://@io ) {
221 if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg)@io ) {
226 # if ( m@[.](gif)@io ) {
227 ## if ( $DEBUG > 2 ) { print "skip GIF $_\n"; }
231 # skip really short or really narrow images
232 if ( $width && $width < $min_width) {
234 print STDERR "skip narrow image $_ ($width x $height)\n";
239 if ( $height && $height < $min_height) {
241 print STDERR "skip short image $_ ($width x $height)\n";
248 if ( $unique_urls{$url} ) {
249 if ( $DEBUG > 2 ) { print STDERR "skip duplicate image $_\n"; }
254 print STDERR "got $url" .
255 ($width && $height ? " (${width}x${height})" : "") .
256 ($was_inline ? " (inline)" : "") . "\n";
259 $urls[++$#urls] = $url;
260 $unique_urls{$url}++;
262 # pointers to images are preferable to inlined images
263 if ( ! $was_inline ) {
264 $urls[++$#urls] = $url;
271 print STDERR "no images on $base\n";
276 return undef if ( $#urls < 1 );
278 # pick a random element of the table
279 my $i = ((rand() * 99999) % $#urls);
281 # if the page has several images on it, prefer the later ones most of
284 if ($#urls > ($fudge * 2) && $i <= $fudge && ((rand() < 0.9))) {
286 print STDERR "skipping first $fudge of $#urls images.\n";
294 print STDERR "picked $url\n";
301 # Using the URL-randomizer, picks a random image on a random page, and
302 # returns two URLs: the page containing the image, and the image.
303 # Returns undef if nothing found this time.
305 sub pick_from_url_randomizer {
308 print STDERR "\n\npicking from $random_redirector...\n\n";
311 my ( $base, $body ) = get_document $random_redirector;
313 return if (!$base || !$body);
314 my $img = pick_image_from_body ($base, $body);
317 return ($base, $img);
327 if (open (IN, "<$wordlist")) {
328 my $size = (stat(IN))[7];
329 my $pos = rand $size;
330 if (seek (IN, $pos, 0)) {
331 $word = <IN>; # toss partial line
332 $word = <IN>; # keep next line
337 return 0 if (!$word);
339 $word =~ s/^[ \t\n\r]+//;
340 $word =~ s/[ \t\n\r]+$//;
343 $word =~ s/ally$/al/;
350 # Using the image-randomizer, picks a random image on a random page, and
351 # returns two URLs: the page containing the image, and the image.
352 # Returns undef if nothing found this time.
354 sub pick_from_image_randomizer {
356 my $words = random_word;
357 $words .= "%20" . random_word;
358 $words .= "%20" . random_word;
360 my $search_url = $image_randomizer . $words;
363 print STDERR "\n\npicking from $search_url\n";
366 my ( $base, $body ) = get_document $search_url;
376 foreach (split(/\n/)) {
378 if ( m@<A HREF=([^>]+)><IMG SRC=http://image\.altavista\.com@i ) {
381 if (m/^"(.*)"$/) { $u = $1; }
383 if (m@\.corbis\.com/@) {
386 print STDERR "skipping corbis URL: $_\n";
389 } elsif ( $DEBUG > 2 ) {
390 print STDERR "sub-page: $1\n";
393 $subpages[++$#subpages] = $u;
397 if ( $#subpages <= 0 ) {
399 print STDERR "Found nothing on $base\n";
404 # pick a random element of the table
405 my $i = ((rand() * 99999) % $#subpages);
406 my $subpage = $subpages[$i];
409 print STDERR "picked page $subpage\n";
414 my ( $base2, $body2 ) = get_document $subpage;
416 return undef if (!$base2 || !body2);
418 my $img = pick_image_from_body ($base2, $body2);
421 return ($base2, $img);
428 # Picks a random image on a random page, and returns two URLs:
429 # the page containing the image, and the image.
430 # Returns undef if nothing found this time.
431 # Uses the url-randomizer 1 time in 5, else the image randomizer.
434 if (int(rand 5) == 0) {
435 return pick_from_url_randomizer;
437 return pick_from_image_randomizer;
442 # returns the full path of the named program, or undef.
446 foreach (split (/:/, $ENV{PATH})) {
456 #################################
460 #################################
467 if ( $progname =~ m/nph-/o ) {
468 print "HTTP/1.0 200 OK\n";
469 print "Content-type: text/html\n";
473 print "<TITLE>random images</TITLE>\n";
474 print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"";
475 print " LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
476 print "<H1 ALIGN=CENTER>random images</H1><P>\n";
477 print "<P><BLOCKQUOTE><BLOCKQUOTE>\n";
478 print "These images have been selected randomly from the web,\n";
479 print "by using both <A HREF=\"$random_redirector\">\n";
480 print "$random_redirector</A> and <A HREF=\"$image_randomizer_a\">\n";
481 print "$image_randomizer_a</A> as a source of URLs from which\n";
482 print "images are extracted.\n";
484 print "Note: if you leave this running\n";
485 print "long enough, your browser will undoubtedly run out of memory\n";
486 print "and crash...\n";
487 print "</BLOCKQUOTE></BLOCKQUOTE><P><HR><P ALIGN=CENTER>\n";
490 my ($base, $img) = pick_image;
493 print STDERR "$img\n";
495 print "<A HREF=\"$base\">";
496 print "<IMG ALIGN=MIDDLE BORDER=0 SRC=\"$img\"></A>\n";
505 #################################
507 # running as an xscreensaver mode
509 #################################
512 my $image = ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp") . "/webcollage." . $$;
513 my $tmp = $image . "-1";
514 my $tmp2 = $image . "-2";
515 my $tmp3 = $image . "-3";
518 if ($DEBUG > 0) { print STDERR "caught signal\n"; }
519 unlink $image, $tmp, $tmp2, $tmp3;
523 my $screen_width = undef;
524 my $screen_height = undef;
528 my $win_cmd = $ppm_to_root_window_cmd;
529 $win_cmd =~ s/^([^ \t\r\n]+).*$/$1/;
531 # make sure the various programs we execute exist, right up front.
532 foreach ("ppmmake", "giftopnm", "djpeg", "pnmpaste", $win_cmd) {
533 which ($_) || die "$progname: $_ not found on \$PATH.\n";
536 $SIG{HUP} = \&x_cleanup;
537 $SIG{INT} = \&x_cleanup;
538 $SIG{QUIT} = \&x_cleanup;
539 $SIG{ABRT} = \&x_cleanup;
540 $SIG{KILL} = \&x_cleanup;
541 $SIG{TERM} = \&x_cleanup;
543 # Need this so that if giftopnm dies, we don't die.
544 $SIG{PIPE} = 'IGNORE';
546 if (!$screen_width || !$screen_height) {
548 ($screen_width, $screen_height) = m/dimensions: *([0-9]+)x([0-9]+) /;
551 my $bgcolor = "#000000";
555 if ($background =~ m/^\#[0-9a-f]+$/i) {
556 $bgcolor = $background;
557 } elsif (-r $background) {
558 $bgimage = $background;
560 } elsif (! $background =~ m@^[-a-z0-9 ]+$@i) {
561 print STDERR "not a color or readable file: $background\n";
564 # default to assuming it's a color
565 $bgcolor = $background;
569 # Create the sold-colored base image.
571 $_ = "ppmmake '$bgcolor' $screen_width $screen_height";
573 print STDERR "creating base image: $_\n";
575 system "$_ > $image";
577 # Paste the default background image in the middle of it.
581 if (open(IMG, "<$bgimage")) {
584 ($iw, $ih) = m/^([0-9]+) ([0-9]+)$/;
587 my $x = int (($screen_width - $iw) / 2);
588 my $y = int (($screen_height - $ih) / 2);
590 print STDERR "pasting $bgimage into base image at $x, $y\n";
592 system "pnmpaste $bgimage $x $y $image > $tmp2 && mv $tmp2 $image";
597 my ($base, $img) = pick_image;
599 my ($headers, $body);
601 ($headers, $body) = get_document ($img);
607 print STDERR "got $img (" . length($body) . ")\n";
611 if ($img =~ m/\.gif/i) {
618 $cmd .= " 2>/dev/null";
621 if (open(PIPE, "| $cmd > $tmp")) {
626 print STDERR "created $tmp ($cmd)\n";
634 print STDERR "running $filter_cmd\n";
636 system "($filter_cmd) < $tmp > $tmp3 && mv $tmp3 $tmp";
640 if (open(IMG, "<$tmp")) {
643 ($iw, $ih) = m/^([0-9]+) ([0-9]+)$/;
650 print STDERR "image size is $iw x $ih\n";
653 if ($iw > $screen_width || $ih > $screen_height) {
654 while ($iw > $screen_width ||
655 $ih > $screen_height) {
660 print STDERR "scaling to $iw x $ih\n";
662 system "pnmscale -xysize $iw $ih $tmp > $tmp2" .
663 " 2>/dev/null && mv $tmp2 $tmp";
666 my $x = int (rand() * ($screen_width - $iw));
667 my $y = int (rand() * ($screen_height - $ih));
670 print STDERR "pasting at $x, $y in $image\n";
673 system "pnmpaste $tmp $x $y $image > $tmp2 " .
674 "&& mv $tmp2 $image";
678 if ($post_filter_cmd) {
680 print STDERR "running $post_filter_cmd\n";
682 system "($post_filter_cmd) < $image > $tmp3";
688 my $tsize = (stat($target))[7];
690 $_ = $ppm_to_root_window_cmd;
694 print STDERR "running $_\n";
698 } elsif ($DEBUG > 1) {
699 print STDERR "$target size is $tsize\n";
704 unlink $tmp, $tmp2, $tmp3;
713 #################################
717 #################################
722 my $usage ="WebCollage, Copyright (c) 1999" .
723 " Jamie Zawinski <jwz\@jwz.org>\n" .
724 " http://www.jwz.org/xscreensaver/\n";
726 if ( $progname =~ m/\.cgi$/i ) {
727 $#ARGV == -1 || die "$usage\nusage: $progname (no arguments)\n";
733 while ($_ = $ARGV[0]) {
735 if ($_ eq "-display" ||
741 $ENV{DISPLAY} = shift @ARGV;
742 } elsif ($_ eq "-root") {
744 } elsif ($_ eq "-no-output") {
746 } elsif ($_ eq "-verbose") {
749 $DEBUG += length($_)-1;
750 } elsif ($_ eq "-delay") {
751 $delay = shift @ARGV;
752 } elsif ($_ eq "-timeout") {
753 $http_timeout = shift @ARGV;
754 } elsif ($_ eq "-filter") {
755 $filter_cmd = shift @ARGV;
756 } elsif ($_ eq "-filter2") {
757 $post_filter_cmd = shift @ARGV;
758 } elsif ($_ eq "-background" || $_ eq "-bg") {
759 $background = shift @ARGV;
760 } elsif ($_ eq "-size") {
762 if (m@^([0-9]+)x([0-9]+)$@) {
766 die "$progname: argument to \"-size\" must be" .
767 " of the form \"640x400\"\n";
770 die "$usage\nusage: $progname [-root]" .
771 " [-display dpy] [-root] [-verbose] [-timeout secs]\n" .
772 "\t\t [-delay secs] [-filter cmd] [-filter2 cmd]\n";
775 if (!$root_p && !$no_output_p) {
776 die "$progname: the -root argument is manditory (for now.)\n";
779 if (!$no_output_p && !$ENV{DISPLAY}) {
780 die "$progname: \$DISPLAY is not set.\n";