X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=hacks%2Fwebcollage;h=bb3c66ef6ded01d0434310ae4c87528fb52b21b9;hb=a94197e76a5dea5cb60542840809d6c20d0abbf3;hp=c1b68ba106002a7464f3bb00277bbcf7bf36b8bd;hpb=a1d41b2aa6e18bf9a49b914a99dda8232c5d7762;p=xscreensaver

diff --git a/hacks/webcollage b/hacks/webcollage
index c1b68ba1..bb3c66ef 100755
--- a/hacks/webcollage
+++ b/hacks/webcollage
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# webcollage, Copyright (c) 1999-2001 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999-2002 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."
 #
@@ -9,7 +9,7 @@
 # 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 
+# software for any purpose.  It is provided "as is" without express or
 # implied warranty.
 
 # To run this as a display mode with xscreensaver, add this to `programs':
@@ -35,8 +35,8 @@ use POSIX qw(strftime);
 
 
 my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.78 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
-my $copyright = "WebCollage $version, Copyright (c) 1999-2001" .
+my $version = q{ $Revision: 1.87 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $copyright = "WebCollage $version, Copyright (c) 1999-2002" .
     " Jamie Zawinski <jwz\@jwz.org>\n" .
     "            http://www.jwz.org/xscreensaver/\n";
 
@@ -56,17 +56,14 @@ my @search_methods = (  30, "imagevista", \&pick_from_alta_vista_images,
                      #   0, "hotbot",     \&pick_from_hotbot_text,
                       );
 
-#@search_methods=(100, "lycos",     \&pick_from_lycos_text);
-@search_methods=(100, "googleimgs",\&pick_from_google_images);
-
 # programs we can use to write to the root window (tried in ascending order.)
 #
-my @root_displayers = ( 
-  "xloadimage -quiet -onroot -center -border black",
-  "xli        -quiet -onroot -center -border black",
-  "xv         -root -quit -viewonly +noresetroot -rmode 5" .
+my @root_displayers = (
+  "chbg       -once -xscreensaver -max_size 100",
+  "xv         -root -quit -viewonly -noresetroot -quick24 -rmode 5" .
   "           -rfg black -rbg black",
-  "chbg       -once -xscreensaver",
+  "xli        -quiet -onroot -center -border black",
+  "xloadimage -quiet -onroot -center -border black",
 
 # this lame program wasn't built with vroot.h:
 # "xsri       -scale -keep-aspect -center-horizontal -center-vertical",
@@ -79,13 +76,27 @@ my %cookies = (
   "www.altavista.com"  =>  "AV_ALL=1",   # request uncensored searches
   "web.altavista.com"  =>  "AV_ALL=1",
 
-                                         # log in as "cpunks"
-  "www.nytimes.com"    =>  "NYT-S=104nv1sChNnnWAvTLGx6eiDhzQcbSoN" .
-                                 "6zOMB7s0Qm8MlMaa8It.2/BlXTrpbBk" .
-                                 "jinV68IcqxOvAABDyKdciIJ8O000",
+                                         # log in as "cipherpunk"
+  "www.nytimes.com"    =>  'NYT-S=18cHMIlJOn2Y1bu5xvEG3Ufuk6E1oJ.' .
+                           'FMxWaQV0igaB5Yi/Q/guDnLeoL.pe7i1oakSb' .
+                           '/VqfdUdb2Uo27Vzt1jmPn3cpYRlTw9',
 );
 
 
+# If this is set, it's a helper program to use for pasting images together:
+# this is a lot faster and more efficient than using PPM pipelines, which is
+# what we do if this program doesn't exist.  (We check for "webcollage-helper"
+# on $PATH at startup, and set this variable appropriately.)
+#
+my $webcollage_helper = undef;
+
+
+# If we have the webcollage-helper program, then it will paste the images
+# together with transparency!  0.0 is invisible, 1.0 is totally opaque.
+#
+my $opacity = 0.85;
+
+
 # Some sites have  managed to poison the search engines.  These are they.
 # (We auto-detect sites that have poisoned the search engines via excessive
 # keywords or dictionary words,  but these are ones that slip through
@@ -102,6 +113,12 @@ my %poisoners = (
                                    # Since Akamai is super-expensive, let's
                                    # go out on a limb and assume that all of
                                    # their customers are rich-and-boring.
+  "bartleby.com"            => 1,  # Dictionary, cluttering altavista.
+  "encyclopedia.com"        => 1,  # Dictionary, cluttering altavista.
+  "onlinedictionary.datasegment.com" => 1,  # Dictionary, cluttering altavista.
+  "hotlinkpics.com"         => 1,  # Porn site that has poisoned imagevista
+                                   # (I don't see how they did it, though!)
+  "alwayshotels.com"        => 1,  # Poisoned Lycos pretty heavily.
 );
 
 
@@ -155,6 +172,9 @@ my $min_width = 50;
 my $min_height = 50;
 my $min_ratio = 1/5;
 
+my $min_gif_area = (120 * 120);
+
+
 my $no_output_p = 0;
 my $urls_only_p = 0;
 
@@ -262,9 +282,8 @@ sub get_document_1 {
         $hdrs .= "Referer: $referer\r\n";
       }
       if ($cookie) {
-        foreach (split(/\r?\n/, $cookie)) {
-          $hdrs .= "Cookie: $_\r\n";
-        }
+        my @cc = split(/\r?\n/, $cookie);
+        $hdrs .= "Cookie: " . join('; ', @cc) . "\r\n";
       }
       $hdrs .= "\r\n";
 
@@ -272,7 +291,7 @@ sub get_document_1 {
         LOG ($verbose_http, "  ==> $_");
       }
       print S $hdrs;
-      my $http = <S>;
+      my $http = <S> || "";
 
       $_  = $http;
       s/[\r\n]+$//s;
@@ -581,6 +600,15 @@ sub pick_image_from_body {
         next;
       }
 
+      # skip GIFs with a small number of pixels -- those usually suck.
+      if ($width && $height &&
+          m/\.gif$/io &&
+          ($width * $height) < $min_gif_area) {
+        LOG ($verbose_filter, "  skip small GIF $_ (${width}x$height)");
+        next;
+      }
+      
+
       my $url = $_;
 
       if ($unique_urls{$url}) {
@@ -589,7 +617,7 @@ sub pick_image_from_body {
       }
 
       LOG ($verbose_filter,
-           "  image $url" . 
+           "  image $url" .
            ($width && $height ? " (${width}x${height})" : "") .
            ($was_inline ? " (inline)" : ""));
 
@@ -615,13 +643,13 @@ sub pick_image_from_body {
   $_ = undef;
   $body = undef;
 
+  @urls = depoison (@urls);
+
   if ( $#urls < 0 ) {
     LOG ($verbose_load, "no images on $base" . ($fsp ? " (frameset)" : ""));
     return ();
   }
 
-  @urls = depoison (@urls);
-
   # pick a random element of the table
   my $i = int(rand($#urls+1));
   $url = $urls[$i];
@@ -656,7 +684,6 @@ sub pick_dictionary {
 # returns a random word from the dictionary
 #
 sub random_word {
-    
     my $word = 0;
     if (open (IN, "<$wordlist")) {
         my $size = (stat(IN))[7];
@@ -692,14 +719,30 @@ sub random_word {
 }
 
 sub random_words {
-  return (random_word . "%20" .
-          random_word . "%20" .
-          random_word . "%20" .
-          random_word . "%20" .
+  my ($or_p) = @_;
+  my $sep = ($or_p ? "%20OR%20" : "%20");
+  return (random_word . $sep .
+          random_word . $sep .
+          random_word . $sep .
+          random_word . $sep .
           random_word);
 }
 
 
+sub url_quote {
+  my ($s) = @_;
+  $s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge;
+  return $s;
+}
+
+sub url_unquote {
+  my ($s) = @_;
+  $s =~ s/[+]/ /g;
+  $s =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
+  return $s;
+}
+
+
 # Loads the given URL (a search on some search engine) and returns:
 # - the total number of hits the search engine claimed it had;
 # - a list of URLs from the page that the search engine returned;
@@ -750,6 +793,12 @@ sub pick_from_search_engine {
     $search_count = $1;
   } elsif ($body =~ m@About ((\d{1,3})(,\d{3})*) images@i) { # imagevista
     $search_count = $1;
+  } elsif ($body =~ m@We found ((\d{1,3})(,\d{3})*|\d+) results@i) { # *vista
+    $search_count = $1;
+  } elsif ($body =~ m@ of about <B>((\d{1,3})(,\d{3})*)<@i) { # googleimages
+    $search_count = $1;
+  } elsif ($body =~ m@<B>((\d{1,3})(,\d{3})*)</B> Web sites were found@i) {
+    $search_count = $1;    # lycos
   } elsif ($body =~ m@WEB.*?RESULTS.*?\b((\d{1,3})(,\d{3})*)\b.*?Matches@i) {
     $search_count = $1;                          # hotbot
   } elsif ($body =~ m@no photos were found containing@i) { # imagevista
@@ -909,7 +958,7 @@ sub pick_from_yahoo_random_link {
     return;
   }
 
-  LOG ($verbose_load, "redirected to: $base"); 
+  LOG ($verbose_load, "redirected to: $base");
 
   my $img = pick_image_from_body ($base, $body);
   $body = undef;
@@ -940,12 +989,11 @@ my $alta_vista_images_url = "http://www.altavista.com/cgi-bin/query" .
                             "&mmW=1" .        # unknown, but required
                             "&q=";
 
-
 # imagevista
 sub pick_from_alta_vista_images {
   my ( $timeout ) = @_;
 
-  my $words = random_words;
+  my $words = random_words(1);
   my $page = (int(rand(9)) + 1);
   my $search_url = $alta_vista_images_url . $words;
 
@@ -959,6 +1007,12 @@ sub pick_from_alta_vista_images {
 
   my @candidates = ();
   foreach my $u (@subpages) {
+
+    # altavista is encoding their URLs now.
+    next unless ($u =~
+    m@^/r\?ck_sm=[a-zA-Z0-9]+\&ref=[a-zA-Z0-9]+(\&uid=[a-zA-Z0-9]+)?\&r=(.*)@);
+    $u = url_unquote($2);
+
     next unless ($u =~ m@^http://@i);    #  skip non-HTTP or relative URLs
     next if ($u =~ m@[/.]altavista\.com\b@i);     # skip altavista builtins
     next if ($u =~ m@[/.]doubleclick\.net\b@i);   # you cretins
@@ -1034,14 +1088,18 @@ sub pick_from_google_images {
 ############################################################################
 
 
-my $alta_vista_url = "http://www.altavista.com/cgi-bin/query?pg=q" .
-                     "&text=yes&kl=XX&stype=stext&q=";
+my $alta_vista_url_1 = "http://www.altavista.com/cgi-bin/query?pg=q" .
+                       "&text=yes&kl=XX&stype=stext&q=";
+my $alta_vista_url_2 = "http://www.altavista.com/sites/search/web?pg=q" .
+                       "&kl=XX&search=Search&q=";
+
+my $alta_vista_url = $alta_vista_url_2;
 
 # altavista
 sub pick_from_alta_vista_text {
   my ( $timeout ) = @_;
 
-  my $words = random_words;
+  my $words = random_words(1);
   my $page = (int(rand(9)) + 1);
   my $search_url = $alta_vista_url . $words;
 
@@ -1061,8 +1119,9 @@ sub pick_from_alta_vista_text {
     # onMouseOver to make it look like they're not!  Well, it makes it
     # easier for us to identify search results...
     #
-    next unless ($u =~ m@^/r\?ck_sm=[a-zA-Z0-9]+\&ref=[a-zA-Z0-9]+\&r=(.*)@);
-    $u = $1;
+    next unless ($u =~
+      m@^/r\?ck_sm=[a-zA-Z0-9]+\&ref=[a-zA-Z0-9]+\&uid=[a-zA-Z0-9]+\&r=(.*)@);
+    $u = url_unquote($1);
 
     LOG ($verbose_filter, "  candidate: $u");
     push @candidates, $u;
@@ -1095,7 +1154,7 @@ my $hotbot_search_url = "http://hotbot.lycos.com/" .
 sub pick_from_hotbot_text {
   my ( $timeout ) = @_;
 
-  my $words = random_words;
+  my $words = random_words(0);
   my $search_url = $hotbot_search_url . $words;
 
   my ($search_hit_count, @subpages) =
@@ -1132,7 +1191,7 @@ my $lycos_search_url = "http://lycospro.lycos.com/srchpro/" .
 sub pick_from_lycos_text {
   my ( $timeout ) = @_;
 
-  my $words = random_words;
+  my $words = random_words(0);
   my $start = int(rand(8)) * 10 + 1;
   my $search_url = $lycos_search_url . $words . "&start=$start";
 
@@ -1171,7 +1230,7 @@ my $yahoo_news_url = "http://search.news.yahoo.com/search/news_photos?" .
 sub pick_from_yahoo_news_text {
   my ( $timeout ) = @_;
 
-  my $words = random_words;
+  my $words = random_words(1);
   my $search_url = $yahoo_news_url . $words;
 
   my ($search_hit_count, @subpages) =
@@ -1180,7 +1239,8 @@ sub pick_from_yahoo_news_text {
   my @candidates = ();
   foreach my $u (@subpages) {
     # only accept URLs on Yahoo's news site
-    next unless ($u =~ m@^http://dailynews.yahoo.com/@i);
+    next unless ($u =~ m@^http://dailynews\.yahoo\.com/@i ||
+                 $u =~ m@^http://story\.news\.yahoo\.com/@i);
 
     LOG ($verbose_filter, "  candidate: $u");
     push @candidates, $u;
@@ -1201,7 +1261,7 @@ sub pick_from_yahoo_news_text {
 
 
 # Picks a random image on a random page, and returns two URLs:
-# the page containing the image, and the image. 
+# the page containing the image, and the image.
 # Returns () if nothing found this time.
 # Uses the url-randomizer 1 time in 5, else the image randomizer.
 #
@@ -1254,8 +1314,8 @@ sub blurb {
 }
 
 sub error {
-  ($_) = @_;
-  print STDERR blurb() . "$_\n";
+  my ($err) = @_;
+  print STDERR blurb() . "$err\n";
   exit 1;
 }
 
@@ -1534,7 +1594,7 @@ sub jpeg_size {
       # We must skip variables, since FFs in variable names aren't
       # valid JPEG markers.
       my $s = substr($body, $i, 2); $i += 2;
-      my ($c1, $c2) = unpack ("C"x2, $s); 
+      my ($c1, $c2) = unpack ("C"x2, $s);
       my $length = ($c1 << 8) | $c2;
       return () if ($length < 2);
       $i += $length-2;
@@ -1626,7 +1686,7 @@ sub x_cleanup {
 #
 sub nontrapping_system {
   $! = 0;
-    
+
   $_ = join(" ", @_);
   s/\"[^\"]+\"/\"...\"/g;
 
@@ -1654,7 +1714,7 @@ sub nontrapping_system {
 
 
 # Given the URL of a GIF or JPEG image, and the body of that image, writes a
-# PPM to the given output file.  Returns the width/height of the image if 
+# PPM to the given output file.  Returns the width/height of the image if
 # successful.
 #
 sub image_to_pnm {
@@ -1768,9 +1828,27 @@ my $ppm_to_root_window_cmd = undef;
 
 sub x_or_pbm_output {
 
+  # Check for our helper program, to see whether we need to use PPM pipelines.
+  #
+  $_ = "webcollage-helper";
+  if (defined ($webcollage_helper) || which ($_)) {
+    $webcollage_helper = $_ unless (defined($webcollage_helper));
+    LOG ($verbose_pbm, "found \"$webcollage_helper\"");
+    $webcollage_helper .= " -v";
+  } else {
+    LOG (($verbose_pbm || $verbose_load), "no $_ program");
+  }
+
   # make sure the various programs we execute exist, right up front.
   #
-  foreach ("ppmmake", "giftopnm", "djpeg", "pnmpaste", "pnmscale", "pnmcut") {
+  my @progs = ("ppmmake");  # always need this one
+
+  if (!defined($webcollage_helper)) {
+    # Only need these others if we don't have the helper.
+    @progs = (@progs, "giftopnm", "djpeg", "pnmpaste", "pnmscale", "pnmcut");
+  }
+
+  foreach (@progs) {
     which ($_) || error "$_ not found on \$PATH.";
   }
 
@@ -1898,11 +1976,34 @@ sub paste_image {
 
   LOG ($verbose_pbm, "got $img (" . length($body) . ")");
 
-  my ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
-  $body = undef;
-  if (!$iw || !$ih) {
-    LOG ($verbose_pbm, "unable to make PBM from $img");
-    return 0;
+  my ($iw, $ih);
+
+  if (defined ($webcollage_helper)) {
+
+    ($iw, $ih) = image_size ($body);
+    if (!$iw || !$ih) {
+      LOG (($verbose_pbm || $verbose_load),
+           "not a GIF or JPG" .
+           (($body =~ m@<(base|html|head|body|script|table|a href)>@i)
+            ? " (looks like HTML)" : "") .
+           ": $img");
+      $suppress_audit = 1;
+      $body = undef;
+      return 0;
+    }
+
+    local *OUT;
+    open (OUT, ">$image_tmp1") || error ("writing $image_tmp1: $!");
+    print OUT $body || error ("writing $image_tmp1: $!");
+    close OUT || error ("writing $image_tmp1: $!");
+
+  } else {
+    ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1);
+    $body = undef;
+    if (!$iw || !$ih) {
+      LOG ($verbose_pbm, "unable to make PBM from $img");
+      return 0;
+    }
   }
 
   record_success ($load_method, $img, $base);
@@ -1939,6 +2040,7 @@ sub paste_image {
   my $target_h = $img_height;
 
   my $cmd = "";
+  my $scale = 1.0;
 
 
   # Usually scale the image to fit on the screen -- but sometimes scale it
@@ -1946,8 +2048,8 @@ sub paste_image {
   # scale it to fit, we instead cut it in half until it fits -- that should
   # give a wider distribution of sizes.
   #
-  if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; }
-  if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; }
+  if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
+  if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
 
   if ($iw > $target_w || $ih > $target_h) {
     while ($iw > $target_w ||
@@ -1995,10 +2097,10 @@ sub paste_image {
   }
 
   if (rand() < $crop_chance) {
-    
+
     my $ow = $crop_w;
     my $oh = $crop_h;
-    
+
     if ($crop_w > $min_width) {
       # if it's a banner, select the width linearly.
       # otherwise, select a bell.
@@ -2013,7 +2115,7 @@ sub paste_image {
       $crop_h = $min_height + int (bellrand() * ($crop_h - $min_height));
       $crop_y = int (rand() * ($oh - $crop_h));
     }
-    
+
     if ($crop_x != 0   || $crop_y != 0 ||
         $crop_w != $iw || $crop_h != $ih) {
       LOG ($verbose_pbm,
@@ -2033,13 +2135,13 @@ sub paste_image {
       $y < 0 ||
       $x + $crop_w > $img_width ||
       $y + $crop_h > $img_height) {
-    
+
     LOG ($verbose_pbm,
          "cropping for effective paste of ${crop_w}x$crop_h \@ $x,$y");
-    
+
     if ($x < 0) { $crop_x -= $x; $crop_w += $x; $x = 0; }
     if ($y < 0) { $crop_y -= $y; $crop_h += $y; $y = 0; }
-    
+
     if ($x + $crop_w >= $img_width)  { $crop_w = $img_width  - $x - 1; }
     if ($y + $crop_h >= $img_height) { $crop_h = $img_height - $y - 1; }
   }
@@ -2060,23 +2162,46 @@ sub paste_image {
 
   $cmd =~ s@^ *\| *@@;
 
-  $_ = "($cmd)";
-  $_ .= " < $image_tmp1 > $image_tmp2";
+  if (defined ($webcollage_helper)) {
+    $cmd = "$webcollage_helper $image_tmp1 $image_ppm " .
+                              "$scale $opacity " .
+                              "$crop_x $crop_y $x $y " .
+                              "$iw $ih";
+    $_ = $cmd;
+
+  } else {
+    # use a PPM pipeline
+    $_ = "($cmd)";
+    $_ .= " < $image_tmp1 > $image_tmp2";
+  }
 
   if ($verbose_pbm) {
     $_ = "($_) 2>&1 | sed s'/^/" . blurb() . "/'";
   } else {
     $_ .= " 2> /dev/null";
   }
+
   my $rc = nontrapping_system ($_);
 
+  if (defined ($webcollage_helper) && -z $image_ppm) {
+    LOG (1, "failed command: \"$cmd\"");
+    print STDERR "\naudit log:\n\n\n";
+    print STDERR ("#" x 78) . "\n";
+    print STDERR blurb() . "$image_ppm has zero size\n";
+    showlog();
+    print STDERR "\n\n";
+    exit (1);
+  }
+
   if ($rc != 0) {
     LOG (($verbose_pbm || $verbose_load), "failed command: \"$cmd\"");
     LOG (($verbose_pbm || $verbose_load), "failed URL: \"$img\" (${ow}x$oh)");
     return;
   }
 
-  rename ($image_tmp2, $image_ppm) || return;
+  if (!defined ($webcollage_helper)) {
+    rename ($image_tmp2, $image_ppm) || return;
+  }
 
   my $target = "$image_ppm";
 
@@ -2097,7 +2222,7 @@ sub paste_image {
     my $tsize = (stat($target))[7];
     if ($tsize > 200) {
       $cmd = "$ppm_to_root_window_cmd $target";
-      
+
       # xv seems to hate being killed.  it tends to forget to clean
       # up after itself, and leaves windows around and colors allocated.
       # I had this same problem with vidwhacker, and I'm not entirely
@@ -2109,14 +2234,14 @@ sub paste_image {
       # to do anyway.
       #
       $cmd .= " &";
-      
+
       $rc = nontrapping_system ($cmd);
-      
+
       if ($rc != 0) {
         LOG (($verbose_pbm || $verbose_load), "display failed: \"$cmd\"");
         return;
       }
-      
+
     } else {
       LOG ($verbose_pbm, "$target size is $tsize");
     }
@@ -2189,6 +2314,24 @@ sub main {
       $http_proxy = shift @ARGV;
     } elsif ($_ eq "-dictionary" || $_ eq "-dict") {
       $dict = shift @ARGV;
+    } elsif ($_ eq "-debug" || $_ eq "--debug") {
+      my $which = shift @ARGV;
+      my @rest = @search_methods;
+      my $ok = 0;
+      while (@rest) {
+        my $pct  = shift @rest;
+        my $name = shift @rest;
+        my $tfn  = shift @rest;
+
+        if ($name eq $which) {
+          @search_methods = (100, $name, $tfn);
+          $ok = 1;
+          last;
+        }
+      }
+      error "no such search method as \"$which\"" unless ($ok);
+      LOG (1, "DEBUG: using only \"$which\"");
+
     } else {
       print STDERR "$copyright\nusage: $progname [-root]" .
                  " [-display dpy] [-root] [-verbose] [-timeout secs]\n" .