X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?p=xscreensaver;a=blobdiff_plain;f=hacks%2Fwebcollage;h=cd3fa4319bbf911a96d56e7323ed3320f84eb98c;hp=eda9cb759203d43c022368a7158058749159564c;hb=c494fd2e6b3b25582375d62e40f4f5cc984ca424;hpb=2d04c4f22466851aedb6ed0f2919d148f726b889 diff --git a/hacks/webcollage b/hacks/webcollage index eda9cb75..cd3fa431 100755 --- a/hacks/webcollage +++ b/hacks/webcollage @@ -60,19 +60,21 @@ use bytes; # Larry can take Unicode and shove it up his ass sideways. my $progname = $0; $progname =~ s@.*/@@g; -my $version = q{ $Revision: 1.123 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; +my $version = q{ $Revision: 1.133 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $copyright = "WebCollage $version, Copyright (c) 1999-2005" . " Jamie Zawinski \n" . " http://www.jwz.org/webcollage/\n"; -my @search_methods = ( 60, "altavista", \&pick_from_alta_vista_random_link, - 12, "livejournal", \&pick_from_livejournal_images, - 8, "yahoorand", \&pick_from_yahoo_random_link, - 11, "googlephotos", \&pick_from_google_image_photos, - 6, "googleimgs", \&pick_from_google_images, +my @search_methods = ( 56, "altavista", \&pick_from_alta_vista_random_link, + 11, "livejournal", \&pick_from_livejournal_images, + 5, "yahoorand", \&pick_from_yahoo_random_link, + 10, "googlephotos", \&pick_from_google_image_photos, + 5, "googleimgs", \&pick_from_google_images, 3, "googlenums", \&pick_from_google_image_numbers, + 2, "flickr_recent", \&pick_from_flickr_recent, + 8, "flickr_random", \&pick_from_flickr_random, # In Apr 2002, Google asked me to stop searching them. # I asked them to add a "random link" url. They said @@ -196,6 +198,7 @@ my %warningless_sites = ( "img.photobucket.com" => 1, "pics.livejournal.com" => 1, "tinypic.com" => 1, + "flickr.com" => 1, "yimg.com" => 1, # This is where dailynews.yahoo.com stores "eimg.com" => 1, # its images, so pick_from_yahoo_news_text() @@ -206,6 +209,40 @@ my %warningless_sites = ( "images.quizdiva.net" => 1, "driftnet" => 1, # builtin... + "local-directory" => 1, # builtin... +); + + +# For decoding HTML-encoded character entities to URLs. +# +my %entity_table = ( + "apos" => '\'', + "quot" => '"', "amp" => '&', "lt" => '<', "gt" => '>', + "nbsp" => ' ', "iexcl" => '¡', "cent" => '¢', "pound" => '£', + "curren" => '¤', "yen" => '¥', "brvbar" => '¦', "sect" => '§', + "uml" => '¨', "copy" => '©', "ordf" => 'ª', "laquo" => '«', + "not" => '¬', "shy" => '­', "reg" => '®', "macr" => '¯', + "deg" => '°', "plusmn" => '±', "sup2" => '²', "sup3" => '³', + "acute" => '´', "micro" => 'µ', "para" => '¶', "middot" => '·', + "cedil" => '¸', "sup1" => '¹', "ordm" => 'º', "raquo" => '»', + "frac14" => '¼', "frac12" => '½', "frac34" => '¾', "iquest" => '¿', + "Agrave" => 'À', "Aacute" => 'Á', "Acirc" => 'Â', "Atilde" => 'Ã', + "Auml" => 'Ä', "Aring" => 'Å', "AElig" => 'Æ', "Ccedil" => 'Ç', + "Egrave" => 'È', "Eacute" => 'É', "Ecirc" => 'Ê', "Euml" => 'Ë', + "Igrave" => 'Ì', "Iacute" => 'Í', "Icirc" => 'Î', "Iuml" => 'Ï', + "ETH" => 'Ð', "Ntilde" => 'Ñ', "Ograve" => 'Ò', "Oacute" => 'Ó', + "Ocirc" => 'Ô', "Otilde" => 'Õ', "Ouml" => 'Ö', "times" => '×', + "Oslash" => 'Ø', "Ugrave" => 'Ù', "Uacute" => 'Ú', "Ucirc" => 'Û', + "Uuml" => 'Ü', "Yacute" => 'Ý', "THORN" => 'Þ', "szlig" => 'ß', + "agrave" => 'à', "aacute" => 'á', "acirc" => 'â', "atilde" => 'ã', + "auml" => 'ä', "aring" => 'å', "aelig" => 'æ', "ccedil" => 'ç', + "egrave" => 'è', "eacute" => 'é', "ecirc" => 'ê', "euml" => 'ë', + "igrave" => 'ì', "iacute" => 'í', "icirc" => 'î', "iuml" => 'ï', + "eth" => 'ð', "ntilde" => 'ñ', "ograve" => 'ò', "oacute" => 'ó', + "ocirc" => 'ô', "otilde" => 'õ', "ouml" => 'ö', "divide" => '÷', + "oslash" => 'ø', "ugrave" => 'ù', "uacute" => 'ú', "ucirc" => 'û', + "uuml" => 'ü', "yacute" => 'ý', "thorn" => 'þ', "yuml" => 'ÿ', + "ndash" => '-', "mdash" => "--" ); @@ -246,6 +283,7 @@ my $min_gif_area = (120 * 120); my $no_output_p = 0; my $urls_only_p = 0; +my $cocoa_p = 0; my $imagemap_base = undef; my @pids_to_kill = (); # forked pids we should kill when we exit, if any. @@ -254,6 +292,9 @@ my $driftnet_magic = 'driftnet'; my $driftnet_dir = undef; my $default_driftnet_cmd = "driftnet -a -m 100"; +my $local_magic = 'local-directory'; +my $local_dir = undef; + my $wordlist; my %rejected_urls; @@ -273,8 +314,8 @@ my @tripwire_words = ("aberrate", "abode", "amorphous", "antioch", # returns three values: the HTTP response line; the document headers; # and the document body. # -sub get_document_1 { - my ( $url, $referer, $timeout ) = @_; +sub get_document_1($$$) { + my ($url, $referer, $timeout) = @_; if (!defined($timeout)) { $timeout = $http_timeout; } if ($timeout > $http_timeout) { $timeout = $http_timeout; } @@ -442,14 +483,18 @@ sub get_document_1 { # 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, $referer, $timeout ) = @_; +sub get_document($$;$) { + my ($url, $referer, $timeout) = @_; my $start = time; if (defined($referer) && $referer eq $driftnet_magic) { return get_driftnet_file ($url); } + if (defined($referer) && $referer eq $local_magic) { + return get_local_file ($url); + } + my $orig_url = $url; my $loop_count = 0; my $max_loop_count = 4; @@ -535,7 +580,7 @@ sub get_document { # in again, but you have to present the old cookie to get the new cookie. # So, by doing this, the built-in cypherpunks cookie will never go "stale". # -sub set_cookie { +sub set_cookie($$) { my ($host, $cookie) = @_; my $oc = $cookies{$host}; return unless $oc; @@ -561,8 +606,8 @@ sub set_cookie { # given a URL and the body text at that URL, selects and returns a random # image from it. returns () if no suitable images found. # -sub pick_image_from_body { - my ( $url, $body ) = @_; +sub pick_image_from_body($$) { + my ($url, $body) = @_; my $base = $url; $_ = $url; @@ -768,6 +813,29 @@ sub pick_image_from_body { return $url; } +# Given a URL and the RSS feed from that URL, pick a random image from +# the feed. This is a lot simpler than extracting images out of a page: +# we already know we have reasonable images, so we just pick one. +# Returns: the real URL of the page (preferably not the RSS version), +# and the image. + +sub pick_image_from_rss($$) { + my ( $url, $body ) = @_; + my @suitable = ($body =~ m/([^<>]+)@i); + $base = $url unless $base; + + # pick a random element of the table + if (@suitable) { + my $i = int(rand(scalar @suitable)); + my $url = $suitable[$i]; + LOG ($verbose_load, "picked image " .($i+1) . "/" . + ($#suitable+1) . ": $url"); + return ($base, $url); + } + return; +} ############################################################################ @@ -777,7 +845,7 @@ sub pick_image_from_body { ############################################################################ -sub pick_dictionary { +sub pick_dictionary() { my @dicts = ("/usr/dict/words", "/usr/share/dict/words", "/usr/share/lib/dict/words"); @@ -792,7 +860,7 @@ sub pick_dictionary { # returns a random word from the dictionary # -sub random_word { +sub random_word() { local *IN; if (! open (IN, "<$wordlist")) { @@ -844,7 +912,7 @@ sub random_word { } -sub random_words { +sub random_words($) { my ($or_p) = @_; my $sep = ($or_p ? "%20OR%20" : "%20"); return (random_word . $sep . @@ -855,20 +923,20 @@ sub random_words { } -sub url_quote { +sub url_quote($) { my ($s) = @_; $s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge; return $s; } -sub url_unquote { +sub url_unquote($) { my ($s) = @_; $s =~ s/[+]/ /g; $s =~ s/%([a-z0-9]{2})/chr(hex($1))/ige; return $s; } -sub html_quote { +sub html_quote($) { my ($s) = @_; $s =~ s/&/&/gi; $s =~ s/ 0); + + my ( $base, $body ) = get_document ($last_search, undef, $timeout); + return () unless $body; + + $body =~ s/[\r\n]/ /gs; + $body =~ s/(]* \b HREF=\"([^<>\"]+)\" [^<>]* > \s* + ]* \b SRC=\"([^<>\"]+)\" @xsi; + next unless defined ($thumb); + $page = html_unquote ($page); + $thumb = html_unquote ($thumb); + + next unless ($thumb =~ m@^http://photos\d*\.flickr\.com/@); + + my $base = "http://www.flickr.com/"; + $page =~ s@^/@$base@; + $thumb =~ s@^/@$base@; + + my $img = $thumb; + $img =~ s/_[a-z](\.[a-z\d]+)$/$1/si; # take off "thumb" suffix + + $count++; + next if ($flickr_cache{$img}); # already have it + + my @pair = ($img, $page, $start); + LOG ($verbose_filter, " candidate: $img"); + push @flickr_cache, \@pair; + $flickr_cache{$img} = \@pair; + $count2++; + } + + return () if ($#flickr_cache == -1); + + my $n = $#flickr_cache+1; + my $i = int(rand($n)); + my ($img, $page) = @{$flickr_cache[$i]}; + + # delete this one from @flickr_cache and from %flickr_cache. + # + @flickr_cache = ( @flickr_cache[0 .. $i-1], + @flickr_cache[$i+1 .. $#flickr_cache] ); + delete $flickr_cache{$img}; + + # Keep the size of the cache under the limit by nuking older entries + # + while ($#flickr_cache >= $flickr_cache_size) { + my $pairP = shift @flickr_cache; + my $img = $pairP->[0]; + delete $flickr_cache{$img}; + } + + LOG ($verbose_load, "picked image " .($i+1) . "/$n: $img"); + + return ($page, $img); +} + + +############################################################################ +# +# Pick images from a random RSS feed on Flickr. +# +############################################################################ + +my $flickr_rss_base = ("http://www.flickr.com/services/feeds/photos_public.gne" . + "?format=rss_200_enc&tags="); + +# Picks a random RSS feed; picks a random image from that feed; +# returns 2 URLs: the page containing the image, and the image. +# Mostly by Joe Mcmahon +# +# flickr_random +sub pick_from_flickr_random($) { + my $timeout = shift; + + my $rss = $flickr_rss_base . random_word(); + $last_search = $rss; + + print STDERR "\n\n" if ($verbose_load); + LOG ($verbose_load, "URL: $last_search"); + + $suppress_audit = 1; + + my ( $base, $body ) = get_document ($last_search, undef, $timeout); + if (!$base || !$body) { + $body = undef; + return; + } + + my $img; + ($base, $img) = pick_image_from_rss ($base, $body); + $body = undef; + return () unless defined ($img); + + LOG ($verbose_load, "redirected to: $base"); + return ($base, $img); +} + ############################################################################ # @@ -1722,8 +1917,8 @@ sub pick_from_ircimages { ############################################################################ # driftnet -sub pick_from_driftnet { - my ( $timeout ) = @_; +sub pick_from_driftnet($) { + my ($timeout) = @_; my $id = $driftnet_magic; my $dir = $driftnet_dir; @@ -1755,7 +1950,7 @@ sub pick_from_driftnet { } -sub get_driftnet_file { +sub get_driftnet_file($) { my ($file) = @_; error ("\$driftnet_dir unset?") unless ($driftnet_dir); @@ -1775,7 +1970,7 @@ sub get_driftnet_file { } -sub spawn_driftnet { +sub spawn_driftnet($) { my ($cmd) = @_; # make a directory to use. @@ -1817,6 +2012,46 @@ sub spawn_driftnet { unless (1 == kill (0, $pid)); } +# local-directory +sub pick_from_local_dir { + my ( $timeout ) = @_; + + my $id = $local_magic; + $last_search = $id; + + my $dir = $local_dir; + error ("\$local_dir unset?") unless ($dir); + $dir =~ s@/+$@@; + + error ("$dir unreadable") unless (-d "$dir/."); + + my $v = ($verbose_exec ? "-v" : ""); + my $pick = `xscreensaver-getimage-file $v "$dir"`; + + LOG ($verbose_load, "picked file $pick ($id)"); + return ($id, $pick); +} + + +sub get_local_file { + my ($file) = @_; + + error ("\$local_dir unset?") unless ($local_dir); + + my $id = $local_magic; + my $re = qr/$local_dir/; + error ("$id: $file not in $local_dir?") + unless ($file =~ m@^$re@o); + + local *IN; + open (IN, $file) || error ("$id: $file: $!"); + my $body = ''; + while () { $body .= $_; } + close IN || error ("$id: $file: $!"); + return ($id, $body); +} + + ############################################################################ # @@ -1830,8 +2065,8 @@ sub spawn_driftnet { # Returns () if nothing found this time. # -sub pick_image { - my ( $timeout ) = @_; +sub pick_image(;$) { + my ($timeout) = @_; $current_state = "select"; $load_method = "none"; @@ -1869,21 +2104,21 @@ sub pick_image { # ############################################################################ -sub timestr { +sub timestr() { return strftime ("%H:%M:%S: ", localtime); } -sub blurb { +sub blurb() { return "$progname: " . timestr() . "$current_state: "; } -sub error { +sub error($) { my ($err) = @_; print STDERR blurb() . "$err\n"; exit 1; } -sub stacktrace { +sub stacktrace() { my $i = 1; print STDERR "$progname: stack trace:\n"; while (1) { @@ -1897,11 +2132,11 @@ sub stacktrace { my $lastlog = ""; -sub clearlog { +sub clearlog() { $lastlog = ""; } -sub showlog { +sub showlog() { my $head = "$progname: DEBUG: "; foreach (split (/\n/, $lastlog)) { print STDERR "$head$_\n"; @@ -1909,7 +2144,7 @@ sub showlog { $lastlog = ""; } -sub LOG { +sub LOG($$) { my ($print, $msg) = @_; my $blurb = timestr() . "$current_state: "; $lastlog .= "$blurb$msg\n"; @@ -1922,7 +2157,7 @@ my %stats_successes; my %stats_elapsed; my $last_state = undef; -sub record_attempt { +sub record_attempt($) { my ($name) = @_; if ($last_state) { @@ -1938,7 +2173,7 @@ sub record_attempt { $suppress_audit = 0; } -sub record_success { +sub record_success($$$) { my ($name, $url, $base) = @_; if (defined($stats_successes{$name})) { $stats_successes{$name}++; @@ -1956,7 +2191,7 @@ sub record_success { } -sub record_failure { +sub record_failure($) { my ($name) = @_; return if $image_succeeded; @@ -1988,7 +2223,7 @@ sub record_failure { -sub stats_of { +sub stats_of($) { my ($name) = @_; my $i = $stats_successes{$name}; my $j = $stats_attempts{$name}; @@ -2000,7 +2235,7 @@ sub stats_of { my $current_start_time = 0; -sub start_timer { +sub start_timer($) { my ($name) = @_; $current_start_time = time; @@ -2014,14 +2249,14 @@ sub start_timer { } } -sub stop_timer { +sub stop_timer($$) { my ($name, $success) = @_; $stats_elapsed{$name} += time - $current_start_time; } my $last_report_time = 0; -sub report_performance { +sub report_performance() { return unless $verbose_warnings; @@ -2055,7 +2290,7 @@ my $max_recent_sites = 20; my @recent_images = (); my @recent_sites = (); -sub save_recent_url { +sub save_recent_url($$) { my ($url, $base) = @_; return unless ($verbose_warnings); @@ -2064,8 +2299,8 @@ sub save_recent_url { my ($site) = m@^http://([^ \t\n\r/:]+)@; return unless defined ($site); - if ($base eq $driftnet_magic) { - $site = $driftnet_magic; + if ($base eq $driftnet_magic || $base eq $local_magic) { + $site = $base; @recent_images = (); } @@ -2117,7 +2352,7 @@ sub save_recent_url { # Does %-decoding. # -sub url_decode { +sub url_decode($) { ($_) = @_; tr/+/ /; s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; @@ -2127,19 +2362,20 @@ sub url_decode { # Given the raw body of a GIF document, returns the dimensions of the image. # -sub gif_size { +sub gif_size($) { my ($body) = @_; my $type = substr($body, 0, 6); my $s; return () unless ($type =~ /GIF8[7,9]a/); $s = substr ($body, 6, 10); my ($a,$b,$c,$d) = unpack ("C"x4, $s); + return () unless defined ($d); return (($b<<8|$a), ($d<<8|$c)); } # Given the raw body of a JPEG document, returns the dimensions of the image. # -sub jpeg_size { +sub jpeg_size($) { my ($body) = @_; my $i = 0; my $L = length($body); @@ -2190,7 +2426,7 @@ sub jpeg_size { # Given the raw body of a PNG document, returns the dimensions of the image. # -sub png_size { +sub png_size($) { my ($body) = @_; return () unless ($body =~ m/^\211PNG\r/); my ($bits) = ($body =~ m/^.{12}(.{12})/s); @@ -2204,7 +2440,7 @@ sub png_size { # Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions # of the image. # -sub image_size { +sub image_size($) { my ($body) = @_; my ($w, $h) = gif_size ($body); if ($w && $h) { return ($w, $h); } @@ -2216,7 +2452,7 @@ sub image_size { # returns the full path of the named program, or undef. # -sub which { +sub which($) { my ($prog) = @_; foreach (split (/:/, $ENV{PATH})) { if (-x "$_/$prog") { @@ -2228,7 +2464,7 @@ sub which { # Like rand(), but chooses numbers with a bell curve distribution. -sub bellrand { +sub bellrand(;$) { ($_) = @_; $_ = 1.0 unless defined($_); $_ /= 3.0; @@ -2236,7 +2472,7 @@ sub bellrand { } -sub exit_cleanup { +sub exit_cleanup() { x_cleanup(); print STDERR "$progname: exiting\n" if ($verbose_warnings); if (@pids_to_kill) { @@ -2245,7 +2481,7 @@ sub exit_cleanup { } } -sub signal_cleanup { +sub signal_cleanup($) { my ($sig) = @_; print STDERR blurb() . (defined($sig) ? "caught signal $sig." @@ -2263,7 +2499,7 @@ sub signal_cleanup { # ############################################################################## -sub url_only_output { +sub url_only_output() { do { my ($base, $img) = pick_image; if ($img) { @@ -2304,7 +2540,7 @@ my $img_height; my $delay = 2; -sub x_cleanup { +sub x_cleanup() { unlink $image_ppm, $image_tmp1, $image_tmp2; unlink $imagemap_html_tmp, $imagemap_jpg_tmp if (defined ($imagemap_html_tmp)); @@ -2314,7 +2550,7 @@ sub x_cleanup { # Like system, but prints status about exit codes, and kills this process # with whatever signal killed the sub-process, if any. # -sub nontrapping_system { +sub nontrapping_system(@) { $! = 0; $_ = join(" ", @_); @@ -2347,7 +2583,7 @@ sub nontrapping_system { # writes a PPM to the given output file. Returns the width/height of the # image if successful. # -sub image_to_pnm { +sub image_to_pnm($$$) { my ($url, $body, $output) = @_; my ($cmd, $cmd2, $w, $h); @@ -2363,7 +2599,7 @@ sub image_to_pnm { } else { LOG (($verbose_pbm || $verbose_load), "not a GIF, JPG, or PNG" . - (($body =~ m@<(base|html|head|body|script|table|a href)>@i) + (($body =~ m@<(base|html|head|body|script|table|a href)\b@i) ? " (looks like HTML)" : "") . ": $url"); $suppress_audit = 1; @@ -2437,9 +2673,43 @@ sub image_to_pnm { } } -sub pick_root_displayer { + +# Same as the "ppmmake" command: creates a solid-colored PPM. +# Does not understand the rgb.txt color names except "black" and "white". +# +sub ppmmake($$$$) { + my ($outfile, $bgcolor, $w, $h) = @_; + + my ($r, $g, $b); + if ($bgcolor =~ m/^\#?([\dA-F][\dA-F])([\dA-F][\dA-F])([\dA-F][\dA-F])$/i || + $bgcolor =~ m/^\#?([\dA-F])([\dA-F])([\dA-F])$/i) { + ($r, $g, $b) = (hex($1), hex($2), hex($3)); + } elsif ($bgcolor =~ m/^black$/i) { + ($r, $g, $b) = (0, 0, 0); + } elsif ($bgcolor =~ m/^white$/i) { + ($r, $g, $b) = (0xFF, 0xFF, 0xFF); + } else { + error ("unparsable color name: $bgcolor"); + } + + my $pixel = pack('CCC', $r, $g, $b); + my $bits = "P6\n$w $h\n255\n" . ($pixel x ($w * $h)); + + local *OUT; + open (OUT, ">$outfile") || error ("$outfile: $!"); + print OUT $bits; + close OUT; +} + + +sub pick_root_displayer() { my @names = (); + if ($cocoa_p) { + # see "xscreensaver/hacks/webcollage-cocoa.m" + return "echo COCOA LOAD "; + } + foreach my $cmd (@root_displayers) { $_ = $cmd; my ($name) = m/^([^ ]+)/; @@ -2459,7 +2729,7 @@ sub pick_root_displayer { my $ppm_to_root_window_cmd = undef; -sub x_or_pbm_output { +sub x_or_pbm_output($) { my ($window_id) = @_; # Check for our helper program, to see whether we need to use PPM pipelines. @@ -2473,9 +2743,14 @@ sub x_or_pbm_output { LOG (($verbose_pbm || $verbose_load), "no $_ program"); } + if ($cocoa_p && !defined ($webcollage_helper)) { + error ("webcollage-helper not found in Cocoa-mode!"); + } + + # make sure the various programs we execute exist, right up front. # - my @progs = ("ppmmake"); # always need this one + my @progs = (); if (!defined($webcollage_helper)) { # Only need these others if we don't have the helper. @@ -2551,9 +2826,8 @@ sub x_or_pbm_output { # Create the sold-colored base image. # - $_ = "ppmmake '$bgcolor' $img_width $img_height"; - LOG ($verbose_pbm, "creating base image: $_"); - nontrapping_system "$_ > $image_ppm"; + LOG ($verbose_pbm, "creating base image: ${img_width}x${img_height}"); + $_ = ppmmake ($image_ppm, $bgcolor, $img_width, $img_height); # Paste the default background image in the middle of it. # @@ -2624,7 +2898,7 @@ sub x_or_pbm_output { } } -sub paste_image { +sub paste_image($$$$) { my ($base, $img, $body, $source) = @_; $current_state = "paste"; @@ -2938,7 +3212,7 @@ sub paste_image { } -sub update_imagemap { +sub update_imagemap($$$$$$$$) { my ($url, $x, $y, $w, $h, $image_ppm, $image_width, $image_height) = @_; $current_state = "imagemap"; @@ -3043,7 +3317,7 @@ sub update_imagemap { } -sub init_signals { +sub init_signals() { $SIG{HUP} = \&signal_cleanup; $SIG{INT} = \&signal_cleanup; @@ -3059,7 +3333,7 @@ sub init_signals { END { exit_cleanup(); } -sub main { +sub main() { $| = 1; srand(time ^ $$); @@ -3095,6 +3369,8 @@ sub main { } elsif ($_ eq "-urls-only") { $urls_only_p = 1; $no_output_p = 1; + } elsif ($_ eq "-cocoa") { + $cocoa_p = 1; } elsif ($_ eq "-imagemap") { $imagemap_base = shift @ARGV; $no_output_p = 1; @@ -3135,6 +3411,13 @@ sub main { } else { $driftnet_cmd = $default_driftnet_cmd; } + } elsif ($_ eq "-directory" || $_ eq "--directory") { + @search_methods = ( 100, "local", \&pick_from_local_dir ); + if (! ($ARGV[0] =~ m/^-/)) { + $local_dir = shift @ARGV; + } else { + error ("local directory path must be set") + } } elsif ($_ eq "-debug" || $_ eq "--debug") { my $which = shift @ARGV; my @rest = @search_methods; @@ -3161,6 +3444,7 @@ sub main { "\t\t [-filter cmd] [-filter2 cmd] [-background color]\n" . "\t\t [-dictionary dictionary-file] [-http-proxy host[:port]]\n" . "\t\t [-driftnet [driftnet-program-and-args]]\n" . + "\t\t [-directory local-image-directory]\n" . "\n"; exit 1; } @@ -3174,12 +3458,12 @@ sub main { $http_proxy = $1; } - if (!$root_p && !$no_output_p) { + if (!$root_p && !$no_output_p && !$cocoa_p) { print STDERR $copyright; error "the -root argument is mandatory (for now.)"; } - if (!$no_output_p && !$ENV{DISPLAY}) { + if (!$no_output_p && !$cocoa_p && !$ENV{DISPLAY}) { error "\$DISPLAY is not set."; } @@ -3241,6 +3525,15 @@ sub main { pick_dictionary(); } + if ($imagemap_base && !($img_width && $img_height)) { + error ("-size WxH is required with -imagemap"); + } + + if (defined ($local_dir)) { + $_ = "xscreensaver-getimage-file"; + which ($_) || error "$_ not found on \$PATH."; + } + init_signals(); spawn_driftnet ($driftnet_cmd) if ($driftnet_cmd); @@ -3252,5 +3545,5 @@ sub main { } } -main; +main(); exit (0);