+++ /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