--- /dev/null
+#!/usr/local/bin/perl5 -w
+#
+# webcollage, for xscreensaver, Copyright (c) 1999 Jamie Zawinski <jwz@jwz.org>
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation. No representations are made about the suitability of this
+# software for any purpose. It is provided "as is" without express or
+# implied warranty.
+#
+#
+# This program decorate the screen with random images from the web.
+
+
+use Socket;
+
+my $progname = "$0";
+my $version = "1.0";
+
+$progname =~ s@^.*/([^/]+)$@$1@;
+
+my $random_redirector = "http://random.yahoo.com/bin/ryl";
+my $image_randomizer_a = "http://image.altavista.com/";
+my $image_randomizer = $image_randomizer_a . "cgi-bin/avncgi" .
+ "?do=3&verb=no&oshape=n&oorder=" .
+ "&ophoto=1&oart=1&ocolor=1&obw=1" .
+ "&stype=simage&oprem=0&query=";
+
+my $http_timeout = 30;
+my $ppm_to_root_window_cmd = "xv -root -rmode 5 -viewonly" .
+ " +noresetroot %%PPM%% -quit";
+my $filter_cmd = undef;
+my $post_filter_cmd = undef;
+my $background = undef;
+my $no_output_p = 0;
+my $delay = 0;
+
+my $wordlist = "/usr/dict/words";
+
+if (!-r $wordlist) {
+ $wordlist = "/usr/share/lib/dict/words"; # irix
+}
+
+
+my $min_width = 50;
+my $min_height = 50;
+
+my $DEBUG = 0;
+
+
+# returns three values: the HTTP response line; the document headers;
+# and the document body.
+#
+sub get_document_1 {
+ my ( $url ) = @_;
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "get_document_1 $url\n";
+ }
+
+ my($dummy, $dummy, $serverstring, $path) = split(/\//, $url, 4);
+ my($them,$port) = split(/:/, $serverstring);
+ $port = 80 unless $port;
+ my $size="";
+
+ my ($remote, $iaddr, $paddr, $proto, $line);
+ $remote = $them;
+ if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
+ return unless $port;
+ $iaddr = inet_aton($remote) || return;
+ $paddr = sockaddr_in($port, $iaddr);
+
+ @_ =
+ eval {
+ local $SIG{ALRM} = sub {
+ if ($DEBUG > 0) {
+ print STDERR "timed out for $url\n";
+ }
+ die "alarm\n" };
+ alarm $http_timeout;
+
+ $proto = getprotobyname('tcp');
+ socket(S, PF_INET, SOCK_STREAM, $proto) || return;
+ connect(S, $paddr) || return;
+
+ select(S); $| = 1; select(STDOUT);
+
+ print S ("GET /$path HTTP/1.0\n" .
+ "Host: $them\n" .
+ "User-Agent: $progname/$version\n" .
+ "\n");
+
+ my $http = <S>;
+
+ my $head = "";
+ my $body = "";
+ while (<S>) {
+ $head .= $_;
+ last if m@^[\r\n]@;
+ }
+ while (<S>) {
+ $body .= $_;
+ }
+
+ close S;
+
+ return ( $http, $head, $body );
+ };
+ die if ($@ && $@ ne "alarm\n"); # propagate errors
+ if ($@) {
+ # timed out
+ return undef;
+ } else {
+ # didn't
+ alarm 0;
+ return @_;
+ }
+}
+
+
+# returns two values: the document headers; and the document body.
+# if the given URL did a redirect, returns the redirected-to document.
+#
+sub get_document {
+ my ( $url ) = @_;
+
+ do {
+ my ( $http, $head, $body ) = get_document_1 $url;
+
+ return undef if ( ! $body );
+
+ if ( $http =~ m@HTTP/[0-9.]+ 30[23]@ ) {
+ $_ = $head;
+ my ( $location ) = m@^location:[ \t]*(.*)$@im;
+ if ( $location ) {
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "redirect from $url to $location\n";
+ }
+ $url = $location;
+ } else {
+ return ( $url, $body );
+ }
+
+ } elsif ( $http =~ m@HTTP/[0-9.]+ [4-9][0-9][0-9]@ ) {
+ # http errors -- return nothing.
+ return undef;
+
+ } else {
+
+ return ( $url, $body );
+ }
+
+ } while (1);
+}
+
+
+# given a URL and the body text at that URL, selects and returns a random
+# image from it. returns undef if no suitable images found.
+#
+sub pick_image_from_body {
+ my ( $base, $body ) = @_;
+
+ $_ = $base;
+
+ # if there's at least one slash after the host, take off the last
+ # pathname component
+ if ( m@^http://[^/]+/@io ) {
+ ( $base = $base ) =~ s@[^/]+$@@go;
+ }
+
+ # if there are no slashes after the host at all, put one on the end.
+ if ( m@^http://[^/]+$@io ) {
+ $base .= "/";
+ }
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "base is $base\n";
+ }
+
+
+ $_ = $body;
+
+ # strip out newlines, compress whitespace
+ s/[\r\n\t ]+/ /go;
+
+ # nuke comments
+ s/<!--.*?-->//go;
+
+ my @urls;
+ my %unique_urls;
+
+ foreach (split(/ *</)) {
+ if ( m/^(img|a) .*(src|href) ?= ?\"? ?(.*?)[ >\"]/io ) {
+
+ my $was_inline = ( "$1" eq "a" || "$1" eq "A" );
+ my $link = $3;
+ my ( $width ) = m/width ?= ?([0-9]+)/oi;
+ my ( $height ) = m/height ?= ?([0-9]+)/oi;
+ $_ = $link;
+
+ if ( m@^/@o ) {
+ my $site;
+ ( $site = $base ) =~ s@^(http://[^/]*).*@$1@gio;
+ $_ = "$site$link";
+ } elsif ( ! m/:/ ) {
+ $_ = "$base$link";
+ s@/\./@/@;
+ while (s@/\.\./@/@g) {
+ }
+ }
+
+ # skip non-http
+ if ( ! m@^http://@io ) {
+ next;
+ }
+
+ # skip non-image
+ if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg)@io ) {
+ next;
+ }
+
+ # skip GIF!
+# if ( m@[.](gif)@io ) {
+## if ( $DEBUG > 2 ) { print "skip GIF $_\n"; }
+# next;
+# }
+
+ # skip really short or really narrow images
+ if ( $width && $width < $min_width) {
+ if ( $DEBUG > 2 ) {
+ print STDERR "skip narrow image $_ ($width x $height)\n";
+ }
+ next;
+ }
+
+ if ( $height && $height < $min_height) {
+ if ( $DEBUG > 2 ) {
+ print STDERR "skip short image $_ ($width x $height)\n";
+ }
+ next;
+ }
+
+ my $url = $_;
+
+ if ( $unique_urls{$url} ) {
+ if ( $DEBUG > 2 ) { print STDERR "skip duplicate image $_\n"; }
+ next;
+ }
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "got $url" .
+ ($width && $height ? " (${width}x${height})" : "") .
+ ($was_inline ? " (inline)" : "") . "\n";
+ }
+
+ $urls[++$#urls] = $url;
+ $unique_urls{$url}++;
+
+ # pointers to images are preferable to inlined images
+ if ( ! $was_inline ) {
+ $urls[++$#urls] = $url;
+ }
+ }
+ }
+
+ if ( $#urls == 0 ) {
+ if ( $DEBUG > 2 ) {
+ print STDERR "no images on $base\n";
+ }
+ return undef;
+ }
+
+ return undef if ( $#urls < 1 );
+
+ # pick a random element of the table
+ my $i = ((rand() * 99999) % $#urls);
+
+ # if the page has several images on it, prefer the later ones most of
+ # the time.
+ my $fudge = 4;
+ if ($#urls > ($fudge * 2) && $i <= $fudge && ((rand() < 0.9))) {
+ if ( $DEBUG > 2 ) {
+ print STDERR "skipping first $fudge of $#urls images.\n";
+ }
+ $i += ($fudge - $i);
+ }
+
+ my $url = $urls[$i];
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "picked $url\n";
+ }
+
+ return $url;
+}
+
+
+# Using the URL-randomizer, picks a random image on a random page, and
+# returns two URLs: the page containing the image, and the image.
+# Returns undef if nothing found this time.
+#
+sub pick_from_url_randomizer {
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "\n\npicking from $random_redirector...\n\n";
+ }
+
+ my ( $base, $body ) = get_document $random_redirector;
+
+ return if (!$base || !$body);
+ my $img = pick_image_from_body ($base, $body);
+
+ if ($img) {
+ return ($base, $img);
+ } else {
+ return undef;
+ }
+}
+
+
+sub random_word {
+
+ my $word = 0;
+ if (open (IN, "<$wordlist")) {
+ my $size = (stat(IN))[7];
+ my $pos = rand $size;
+ if (seek (IN, $pos, 0)) {
+ $word = <IN>; # toss partial line
+ $word = <IN>; # keep next line
+ }
+ close (IN);
+ }
+
+ return 0 if (!$word);
+
+ $word =~ s/^[ \t\n\r]+//;
+ $word =~ s/[ \t\n\r]+$//;
+ $word =~ s/ly$//;
+ $word =~ s/ies$/y/;
+ $word =~ s/ally$/al/;
+
+ return $word;
+}
+
+
+
+# Using the image-randomizer, picks a random image on a random page, and
+# returns two URLs: the page containing the image, and the image.
+# Returns undef if nothing found this time.
+#
+sub pick_from_image_randomizer {
+
+ my $words = random_word;
+ $words .= "%20" . random_word;
+ $words .= "%20" . random_word;
+
+ my $search_url = $image_randomizer . $words;
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "\n\npicking from $search_url\n";
+ }
+
+ my ( $base, $body ) = get_document $search_url;
+
+ return if (! $body);
+
+
+ my @subpages;
+ my $skipped = 0;
+
+ $_ = $body;
+ s/(<A )/\n$1/gi;
+ foreach (split(/\n/)) {
+
+ if ( m@<A HREF=([^>]+)><IMG SRC=http://image\.altavista\.com@i ) {
+
+ my $u = $1;
+ if (m/^"(.*)"$/) { $u = $1; }
+
+ if (m@\.corbis\.com/@) {
+ $skipped = 1;
+ if ( $DEBUG > 2 ) {
+ print STDERR "skipping corbis URL: $_\n";
+ }
+ next;
+ } elsif ( $DEBUG > 2 ) {
+ print STDERR "sub-page: $1\n";
+ }
+
+ $subpages[++$#subpages] = $u;
+ }
+ }
+
+ if ( $#subpages <= 0 ) {
+ if (!$skipped) {
+ print STDERR "Found nothing on $base\n";
+ }
+ return undef;
+ }
+
+ # pick a random element of the table
+ my $i = ((rand() * 99999) % $#subpages);
+ my $subpage = $subpages[$i];
+
+ if ( $DEBUG > 2 ) {
+ print STDERR "picked page $subpage\n";
+ }
+
+
+
+ my ( $base2, $body2 ) = get_document $subpage;
+
+ return undef if (!$base2 || !body2);
+
+ my $img = pick_image_from_body ($base2, $body2);
+
+ if ($img) {
+ return ($base2, $img);
+ } else {
+ return undef;
+ }
+}
+
+
+# Picks a random image on a random page, and returns two URLs:
+# the page containing the image, and the image.
+# Returns undef if nothing found this time.
+# Uses the url-randomizer 1 time in 5, else the image randomizer.
+#
+sub pick_image {
+ if (int(rand 5) == 0) {
+ return pick_from_url_randomizer;
+ } else {
+ return pick_from_image_randomizer;
+ }
+}
+
+
+# returns the full path of the named program, or undef.
+#
+sub which {
+ my ($prog) = @_;
+ foreach (split (/:/, $ENV{PATH})) {
+ if (-x "$_/$prog") {
+ return $prog;
+ }
+ }
+ return undef;
+}
+
+
+
+#################################
+#
+# running as a CGI
+#
+#################################
+
+
+sub do_html_output {
+
+ $| = 1;
+
+ if ( $progname =~ m/nph-/o ) {
+ print "HTTP/1.0 200 OK\n";
+ print "Content-type: text/html\n";
+ print "\n";
+ }
+
+ print "<TITLE>random images</TITLE>\n";
+ print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"";
+ print " LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
+ print "<H1 ALIGN=CENTER>random images</H1><P>\n";
+ print "<P><BLOCKQUOTE><BLOCKQUOTE>\n";
+ print "These images have been selected randomly from the web,\n";
+ print "by using both <A HREF=\"$random_redirector\">\n";
+ print "$random_redirector</A> and <A HREF=\"$image_randomizer_a\">\n";
+ print "$image_randomizer_a</A> as a source of URLs from which\n";
+ print "images are extracted.\n";
+ print "<P>\n";
+ print "Note: if you leave this running\n";
+ print "long enough, your browser will undoubtedly run out of memory\n";
+ print "and crash...\n";
+ print "</BLOCKQUOTE></BLOCKQUOTE><P><HR><P ALIGN=CENTER>\n";
+
+ do {
+ my ($base, $img) = pick_image;
+ if ($img) {
+ if ($DEBUG > 0) {
+ print STDERR "$img\n";
+ }
+ print "<A HREF=\"$base\">";
+ print "<IMG ALIGN=MIDDLE BORDER=0 SRC=\"$img\"></A>\n";
+ }
+
+ sleep $delay;
+
+ } while (1);
+}
+
+
+#################################
+#
+# running as an xscreensaver mode
+#
+#################################
+
+
+my $image = ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp") . "/webcollage." . $$;
+my $tmp = $image . "-1";
+my $tmp2 = $image . "-2";
+my $tmp3 = $image . "-3";
+
+sub x_cleanup {
+ if ($DEBUG > 0) { print STDERR "caught signal\n"; }
+ unlink $image, $tmp, $tmp2, $tmp3;
+ exit 1;
+}
+
+my $screen_width = undef;
+my $screen_height = undef;
+
+sub do_x_output {
+
+ my $win_cmd = $ppm_to_root_window_cmd;
+ $win_cmd =~ s/^([^ \t\r\n]+).*$/$1/;
+
+ # make sure the various programs we execute exist, right up front.
+ foreach ("ppmmake", "giftopnm", "djpeg", "pnmpaste", $win_cmd) {
+ which ($_) || die "$progname: $_ not found on \$PATH.\n";
+ }
+
+ $SIG{HUP} = \&x_cleanup;
+ $SIG{INT} = \&x_cleanup;
+ $SIG{QUIT} = \&x_cleanup;
+ $SIG{ABRT} = \&x_cleanup;
+ $SIG{KILL} = \&x_cleanup;
+ $SIG{TERM} = \&x_cleanup;
+
+ # Need this so that if giftopnm dies, we don't die.
+ $SIG{PIPE} = 'IGNORE';
+
+ if (!$screen_width || !$screen_height) {
+ $_ = `xdpyinfo`;
+ ($screen_width, $screen_height) = m/dimensions: *([0-9]+)x([0-9]+) /;
+ }
+
+ my $bgcolor = "#000000";
+ my $bgimage = undef;
+
+ if ($background) {
+ if ($background =~ m/^\#[0-9a-f]+$/i) {
+ $bgcolor = $background;
+ } elsif (-r $background) {
+ $bgimage = $background;
+
+ } elsif (! $background =~ m@^[-a-z0-9 ]+$@i) {
+ print STDERR "not a color or readable file: $background\n";
+ exit 1;
+ } else {
+ # default to assuming it's a color
+ $bgcolor = $background;
+ }
+ }
+
+ # Create the sold-colored base image.
+ #
+ $_ = "ppmmake '$bgcolor' $screen_width $screen_height";
+ if ($DEBUG > 1) {
+ print STDERR "creating base image: $_\n";
+ }
+ system "$_ > $image";
+
+ # Paste the default background image in the middle of it.
+ #
+ if ($bgimage) {
+ my ($iw, $ih);
+ if (open(IMG, "<$bgimage")) {
+ $_ = <IMG>;
+ $_ = <IMG>;
+ ($iw, $ih) = m/^([0-9]+) ([0-9]+)$/;
+ close (IMG);
+ }
+ my $x = int (($screen_width - $iw) / 2);
+ my $y = int (($screen_height - $ih) / 2);
+ if ($DEBUG > 1) {
+ print STDERR "pasting $bgimage into base image at $x, $y\n";
+ }
+ system "pnmpaste $bgimage $x $y $image > $tmp2 && mv $tmp2 $image";
+ }
+
+
+ do {
+ my ($base, $img) = pick_image;
+
+ my ($headers, $body);
+ if ($img) {
+ ($headers, $body) = get_document ($img);
+ }
+
+ if ($body) {
+
+ if ($DEBUG > 0) {
+ print STDERR "got $img (" . length($body) . ")\n";
+ }
+
+ my $cmd;
+ if ($img =~ m/\.gif/i) {
+ $cmd = "giftopnm";
+ } else {
+ $cmd = "djpeg";
+ }
+
+ if ($DEBUG == 0) {
+ $cmd .= " 2>/dev/null";
+ }
+
+ if (open(PIPE, "| $cmd > $tmp")) {
+ print PIPE $body;
+ close PIPE;
+
+ if ($DEBUG > 1) {
+ print STDERR "created $tmp ($cmd)\n";
+ }
+ }
+
+ if (-s $tmp) {
+
+ if ($filter_cmd) {
+ if ($DEBUG > 1) {
+ print STDERR "running $filter_cmd\n";
+ }
+ system "($filter_cmd) < $tmp > $tmp3 && mv $tmp3 $tmp";
+ }
+
+ my ($iw, $ih);
+ if (open(IMG, "<$tmp")) {
+ $_ = <IMG>;
+ $_ = <IMG>;
+ ($iw, $ih) = m/^([0-9]+) ([0-9]+)$/;
+ close (IMG);
+ }
+
+ if ($iw && $ih) {
+
+ if ($DEBUG > 1) {
+ print STDERR "image size is $iw x $ih\n";
+ }
+
+ if ($iw > $screen_width || $ih > $screen_height) {
+ while ($iw > $screen_width ||
+ $ih > $screen_height) {
+ $iw = int($iw / 2);
+ $ih = int($ih / 2);
+ }
+ if ($DEBUG > 1) {
+ print STDERR "scaling to $iw x $ih\n";
+ }
+ system "pnmscale -xysize $iw $ih $tmp > $tmp2" .
+ " 2>/dev/null && mv $tmp2 $tmp";
+ }
+
+ my $x = int (rand() * ($screen_width - $iw));
+ my $y = int (rand() * ($screen_height - $ih));
+
+ if ($DEBUG > 1) {
+ print STDERR "pasting at $x, $y in $image\n";
+ }
+
+ system "pnmpaste $tmp $x $y $image > $tmp2 " .
+ "&& mv $tmp2 $image";
+
+
+ my $target = $image;
+ if ($post_filter_cmd) {
+ if ($DEBUG > 1) {
+ print STDERR "running $post_filter_cmd\n";
+ }
+ system "($post_filter_cmd) < $image > $tmp3";
+ $target = $tmp3;
+ }
+
+ if (!$no_output_p) {
+
+ my $tsize = (stat($target))[7];
+ if ($tsize > 200) {
+ $_ = $ppm_to_root_window_cmd;
+ s/%%PPM%%/$target/;
+
+ if ($DEBUG > 1) {
+ print STDERR "running $_\n";
+ }
+ system $_;
+
+ } elsif ($DEBUG > 1) {
+ print STDERR "$target size is $tsize\n";
+ }
+ }
+ }
+ }
+ unlink $tmp, $tmp2, $tmp3;
+ }
+
+ sleep $delay;
+
+ } while (1);
+}
+
+
+#################################
+#
+# decide how to run
+#
+#################################
+
+sub main {
+ srand(time ^ $$);
+
+ my $usage ="WebCollage, Copyright (c) 1999" .
+ " Jamie Zawinski <jwz\@jwz.org>\n" .
+ " http://www.jwz.org/xscreensaver/\n";
+
+ if ( $progname =~ m/\.cgi$/i ) {
+ $#ARGV == -1 || die "$usage\nusage: $progname (no arguments)\n";
+ do_html_output;
+
+ } else {
+ my $root_p = 0;
+
+ while ($_ = $ARGV[0]) {
+ shift @ARGV;
+ if ($_ eq "-display" ||
+ $_ eq "-displ" ||
+ $_ eq "-disp" ||
+ $_ eq "-dis" ||
+ $_ eq "-dpy" ||
+ $_ eq "-d") {
+ $ENV{DISPLAY} = shift @ARGV;
+ } elsif ($_ eq "-root") {
+ $root_p = 1;
+ } elsif ($_ eq "-no-output") {
+ $no_output_p = 1;
+ } elsif ($_ eq "-verbose") {
+ $DEBUG++;
+ } elsif (m/^-v+$/) {
+ $DEBUG += length($_)-1;
+ } elsif ($_ eq "-delay") {
+ $delay = shift @ARGV;
+ } elsif ($_ eq "-timeout") {
+ $http_timeout = shift @ARGV;
+ } elsif ($_ eq "-filter") {
+ $filter_cmd = shift @ARGV;
+ } elsif ($_ eq "-filter2") {
+ $post_filter_cmd = shift @ARGV;
+ } elsif ($_ eq "-background" || $_ eq "-bg") {
+ $background = shift @ARGV;
+ } elsif ($_ eq "-size") {
+ $_ = shift @ARGV;
+ if (m@^([0-9]+)x([0-9]+)$@) {
+ $screen_width = $1;
+ $screen_height = $2;
+ } else {
+ die "$progname: argument to \"-size\" must be" .
+ " of the form \"640x400\"\n";
+ }
+ } else {
+ die "$usage\nusage: $progname [-root]" .
+ " [-display dpy] [-root] [-verbose] [-timeout secs]\n" .
+ "\t\t [-delay secs] [-filter cmd] [-filter2 cmd]\n";
+ }
+ }
+ if (!$root_p && !$no_output_p) {
+ die "$progname: the -root argument is manditory (for now.)\n";
+ }
+
+ if (!$no_output_p && !$ENV{DISPLAY}) {
+ die "$progname: \$DISPLAY is not set.\n";
+ }
+
+ do_x_output;
+ }
+}
+
+main;
+exit 0;
projects / xscreensaver / blobdiff