home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / xscreensaver-getimage-file < prev    next >
Encoding:
Text File  |  2009-09-22  |  15.8 KB  |  551 lines
  1. #!/usr/bin/perl -w
  2. # Copyright ⌐ 2001-2008 Jamie Zawinski <jwz@jwz.org>.
  3. #
  4. # Permission to use, copy, modify, distribute, and sell this software and its
  5. # documentation for any purpose is hereby granted without fee, provided that
  6. # the above copyright notice appear in all copies and that both that
  7. # copyright notice and this permission notice appear in supporting
  8. # documentation.  No representations are made about the suitability of this
  9. # software for any purpose.  It is provided "as is" without express or 
  10. # implied warranty.
  11. #
  12. # This program chooses a random file from under the given directory, and
  13. # prints its name.  The file will be an image file whose dimensions are
  14. # larger than a certain minimum size.
  15. #
  16. # The various xscreensaver hacks that manipulate images ("jigsaw", etc.) get
  17. # the image to manipulate by running the "xscreensaver-getimage" program.
  18. #
  19. # Under X11, the "xscreensaver-getimage" program invokes this script,
  20. # depending on the value of the "chooseRandomImages" and "imageDirectory"
  21. # settings in the ~/.xscreensaver file (or .../app-defaults/XScreenSaver).
  22. #
  23. # Under Cocoa, this script lives inside the .saver bundle, and is invoked
  24. # directly from utils/grabclient.c.
  25. #
  26. # Created: 12-Apr-01.
  27.  
  28. require 5;
  29. #use diagnostics;    # Fails on some MacOS 10.5 systems
  30. use strict;
  31.  
  32. use POSIX;
  33. use Fcntl;
  34.  
  35. use Fcntl ':flock'; # import LOCK_* constants
  36.  
  37. use POSIX ':fcntl_h';                # S_ISDIR was here in Perl 5.6
  38. import Fcntl ':mode' unless defined &S_ISDIR;    # but it is here in Perl 5.8
  39.  
  40. use bytes;  # Larry can take Unicode and shove it up his ass sideways.
  41.             # Perl 5.8.0 causes us to start getting incomprehensible
  42.             # errors about UTF-8 all over the place without this.
  43.  
  44. my $progname = $0; $progname =~ s@.*/@@g;
  45. my $version = q{ $Revision: 1.26 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
  46.  
  47. my $verbose = 0;
  48.  
  49. # Whether to use MacOS X's Spotlight to generate the list of files.
  50. # When set to -1, uses Spotlight if "mdfind" exists.
  51. #
  52. # (In my experience, this isn't actually any faster, and might not find
  53. # everything if your Spotlight index is out of date, which happens often.)
  54. #
  55. my $use_spotlight_p = 0;
  56.  
  57. # Whether to cache the results of the last run.
  58. #
  59. my $cache_p = 1;
  60.  
  61. # Regenerate the cache if it is older than this many seconds.
  62. #
  63. my $cache_max_age = 60 * 60 * 3;   # 3 hours
  64.  
  65.  
  66. # This matches files that we are allowed to use as images (case-insensitive.)
  67. # Anything not matching this is ignored.  This is so you can point your
  68. # imageDirectory at directory trees that have things other than images in
  69. # them, but it assumes that you gave your images sensible file extensions.
  70. #
  71. my @good_extensions = ('jpg', 'jpeg', 'pjpeg', 'pjpg', 'png', 'gif',
  72.                        'tif', 'tiff', 'xbm', 'xpm');
  73. my $good_file_re = '\.(' . join("|", @good_extensions) . ')$';
  74.  
  75. # This matches file extensions that might occur in an image directory,
  76. # and that are never used in the name of a subdirectory.  This is an
  77. # optimization that prevents us from having to stat() those files to
  78. # tell whether they are directories or not.  (It speeds things up a
  79. # lot.  Don't give your directories stupid names.)
  80. #
  81. my @nondir_extensions = ('ai', 'bmp', 'bz2', 'cr2', 'crw', 'db',
  82.    'dmg', 'eps', 'gz', 'hqx', 'htm', 'html', 'icns', 'ilbm', 'mov',
  83.    'nef', 'pbm', 'pdf', 'pl', 'ppm', 'ps', 'psd', 'sea', 'sh', 'shtml',
  84.    'tar', 'tgz', 'thb', 'txt', 'xcf', 'xmp', 'Z', 'zip' );
  85. my $nondir_re = '\.(' . join("|", @nondir_extensions) . ')$';
  86.  
  87.  
  88. # JPEG, GIF, and PNG files that are are smaller than this are rejected:
  89. # this is so that you can use an image directory that contains both big
  90. # images and thumbnails, and have it only select the big versions.
  91. #
  92. my $min_image_width  = 255;
  93. my $min_image_height = 255;
  94.  
  95. my @all_files = ();         # list of "good" files we've collected
  96. my %seen_inodes;            # for breaking recursive symlink loops
  97.  
  98. # For diagnostic messages:
  99. #
  100. my $dir_count = 1;          # number of directories seen
  101. my $stat_count = 0;        # number of files/dirs stat'ed
  102. my $skip_count_unstat = 0;  # number of files skipped without stat'ing
  103. my $skip_count_stat = 0;    # number of files skipped after stat
  104.  
  105. sub find_all_files {
  106.   my ($dir) = @_;
  107.  
  108.   print STDERR "$progname:  + reading dir $dir/...\n" if ($verbose > 1);
  109.  
  110.   local *DIR;
  111.   if (! opendir (DIR, $dir)) {
  112.     print STDERR "$progname: couldn't open $dir: $!\n" if ($verbose);
  113.     return;
  114.   }
  115.   my @files = readdir (DIR);
  116.   closedir (DIR);
  117.  
  118.   my @dirs = ();
  119.  
  120.   foreach my $file (@files) {
  121.     next if ($file =~ m/^\./);      # silently ignore dot files/dirs
  122.  
  123.     if ($file =~ m/[~%\#]$/) {      # ignore backup files (and dirs...)
  124.       $skip_count_unstat++;
  125.       print STDERR "$progname:  - skip file  $file\n" if ($verbose > 1);
  126.     }
  127.  
  128.     $file = "$dir/$file";
  129.  
  130.     if ($file =~ m/$good_file_re/io) {
  131.       #
  132.       # Assume that files ending in .jpg exist and are not directories.
  133.       #
  134.       push @all_files, $file;
  135.       print STDERR "$progname:  - found file $file\n" if ($verbose > 1);
  136.  
  137.     } elsif ($file =~ m/$nondir_re/io) {
  138.       #
  139.       # Assume that files ending in .html are not directories.
  140.       #
  141.       $skip_count_unstat++;
  142.       print STDERR "$progname: -- skip file  $file\n" if ($verbose > 1);
  143.  
  144.     } else {
  145.       #
  146.       # Now we need to stat the file to see if it's a subdirectory.
  147.       #
  148.       # Note: we could use the trick of checking "nlinks" on the parent
  149.       # directory to see if this directory contains any subdirectories,
  150.       # but that would exclude any symlinks to directories.
  151.       #
  152.       my @st = stat($file);
  153.       my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  154.           $atime,$mtime,$ctime,$blksize,$blocks) = @st;
  155.  
  156.       $stat_count++;
  157.  
  158.       if ($#st == -1) {
  159.         if ($verbose) {
  160.           my $ll = readlink $file;
  161.           if (defined ($ll)) {
  162.             print STDERR "$progname: + dangling symlink: $file -> $ll\n";
  163.           } else {
  164.             print STDERR "$progname: + unreadable: $file\n";
  165.           }
  166.         }
  167.         next;
  168.       }
  169.  
  170.       next if ($seen_inodes{"$dev:$ino"}); # break symlink loops
  171.       $seen_inodes{"$dev:$ino"} = 1;
  172.  
  173.       if (S_ISDIR($mode)) {
  174.         push @dirs, $file;
  175.         $dir_count++;
  176.         print STDERR "$progname:  + found dir  $file\n" if ($verbose > 1);
  177.  
  178.       } else {
  179.         $skip_count_stat++;
  180.         print STDERR "$progname:  + skip file  $file\n" if ($verbose > 1);
  181.       }
  182.     }
  183.   }
  184.  
  185.   foreach (@dirs) {
  186.     find_all_files ($_);
  187.   }
  188. }
  189.  
  190.  
  191. sub spotlight_all_files {
  192.   my ($dir) = @_;
  193.  
  194.   my @terms = ();
  195.   # "public.image" matches all (indexed) images, including Photoshop, etc.
  196. #  push @terms, "kMDItemContentTypeTree == 'public.image'";
  197.   foreach (@good_extensions) {
  198.  
  199.     # kMDItemFSName hits the file system every time: much worse than "find".
  200. #    push @terms, "kMDItemFSName == '*.$_'";
  201.  
  202.     # kMDItemDisplayName matches against the name in the Spotlight index,
  203.     # but won't find files that (for whatever reason) didn't get indexed.
  204.     push @terms, "kMDItemDisplayName == '*.$_'";
  205.   }
  206.  
  207.   $dir =~ s@([^-_/a-z\d.,])@\\$1@gsi;  # quote for sh
  208.   my $cmd = "mdfind -onlyin $dir \"" . join (' || ', @terms) . "\"";
  209.  
  210.   print STDERR "$progname: executing: $cmd\n" if ($verbose > 1);
  211.   @all_files = split (/[\r\n]+/, `$cmd`);
  212. }
  213.  
  214.  
  215. # If we're using cacheing, read the cache file and return its contents,
  216. # if any.  This also holds an exclusive lock on the cache file, which 
  217. # has the additional benefit that if two copies of this program are
  218. # running at once, one will wait for the other, instead of both of
  219. # them spanking the same file system at the same time.
  220. #
  221. local *CACHE_FILE;
  222. my $cache_file_name = undef;
  223. my $read_cache_p = 0;
  224.  
  225. sub read_cache($) {
  226.   my ($dir) = @_;
  227.  
  228.   return () unless ($cache_p);
  229.  
  230.   my $dd = "$ENV{HOME}/Library/Caches";    # MacOS location
  231.   if (-d $dd) {
  232.     $cache_file_name = "$dd/org.jwz.xscreensaver.getimage.cache";
  233.   } elsif (-d "$ENV{HOME}/tmp") {
  234.     $cache_file_name = "$ENV{HOME}/tmp/.xscreensaver-getimage.cache";
  235.   } else {
  236.     $cache_file_name = "$ENV{HOME}/.xscreensaver-getimage.cache";
  237.   }
  238.  
  239.   my $file = $cache_file_name;
  240.   open (CACHE_FILE, "+>>$file") || error ("unable to write $file: $!");
  241.   flock (CACHE_FILE, LOCK_EX)   || error ("unable to lock $file: $!");
  242.   seek (CACHE_FILE, 0, 0)       || error ("unable to rewind $file: $!");
  243.  
  244.   print STDERR "$progname: reading cache $cache_file_name\n"
  245.     if ($verbose > 1);
  246.  
  247.   my $mtime = (stat(CACHE_FILE))[9];
  248.  
  249.   if ($mtime + $cache_max_age < time) {
  250.     print STDERR "$progname: cache is too old\n" if ($verbose);
  251.     return ();
  252.   }
  253.  
  254.   my $odir = <CACHE_FILE>;
  255.   $odir =~ s/[\r\n]+$//s if defined ($odir);
  256.   if (!defined ($odir) || ($dir ne $odir)) {
  257.     print STDERR "$progname: cache is for $odir, not $dir\n"
  258.       if ($verbose && $odir);
  259.     return ();
  260.   }
  261.  
  262.   my @files = ();
  263.   while (<CACHE_FILE>) { 
  264.     s/[\r\n]+$//s;
  265.     push @files, "$odir/$_";
  266.   }
  267.  
  268.   print STDERR "$progname: " . ($#files+1) . " files in cache\n"
  269.     if ($verbose);
  270.  
  271.   $read_cache_p = 1;
  272.   return @files;
  273. }
  274.  
  275.  
  276. sub write_cache($) {
  277.   my ($dir) = @_;
  278.  
  279.   return unless ($cache_p);
  280.  
  281.   # If we read the cache, just close it without rewriting it.
  282.   # If we didn't read it, then write it now.
  283.  
  284.   if (! $read_cache_p) {
  285.  
  286.     truncate (CACHE_FILE, 0) ||
  287.       error ("unable to truncate $cache_file_name: $!");
  288.     seek (CACHE_FILE, 0, 0) ||
  289.       error ("unable to rewind $cache_file_name: $!");
  290.  
  291.     if ($#all_files >= 0) {
  292.       print CACHE_FILE "$dir\n";
  293.       my $re = qr/$dir/;
  294.       foreach (@all_files) {
  295.         my $f = $_; # stupid Perl. do this to avoid modifying @all_files!
  296.         $f =~ s@^$re/@@so || die;
  297.         print CACHE_FILE "$f\n";
  298.       }
  299.     }
  300.  
  301.     print STDERR "$progname: cached " . ($#all_files+1) . " files\n"
  302.       if ($verbose);
  303.   }
  304.  
  305.   flock (CACHE_FILE, LOCK_UN) ||
  306.     error ("unable to unlock $cache_file_name: $!");
  307.   close (CACHE_FILE);
  308. }
  309.  
  310.  
  311. sub find_random_file($) {
  312.   my ($dir) = @_;
  313.  
  314.   $dir =~ s@/+$@@g;
  315.  
  316.   if ($use_spotlight_p == -1) {
  317.     $use_spotlight_p = 0;
  318.     if (-x '/usr/bin/mdfind') {
  319.       $use_spotlight_p = 1;
  320.     }
  321.   }
  322.  
  323.   @all_files = read_cache ($dir);
  324.  
  325.   if ($#all_files >= 0) {
  326.     # got it from the cache...
  327.  
  328.   } elsif ($use_spotlight_p) {
  329.     print STDERR "$progname: spotlighting $dir...\n" if ($verbose);
  330.     spotlight_all_files ($dir);
  331.     print STDERR "$progname: found " . ($#all_files+1) .
  332.                  " file" . ($#all_files == 0 ? "" : "s") .
  333.                  " via Spotlight\n"
  334.       if ($verbose);
  335.   } else {
  336.     print STDERR "$progname: recursively reading $dir...\n" if ($verbose);
  337.     find_all_files ($dir);
  338.     print STDERR "$progname: " .
  339.                  "f=" . ($#all_files+1) . "; " .
  340.                  "d=$dir_count; " .
  341.                  "s=$stat_count; " .
  342.                  "skip=${skip_count_unstat}+$skip_count_stat=" .
  343.                   ($skip_count_unstat + $skip_count_stat) .
  344.                  ".\n"
  345.       if ($verbose);
  346.   }
  347.  
  348.   write_cache ($dir);
  349.  
  350.   @all_files = sort(@all_files);
  351.  
  352.   if ($#all_files < 0) {
  353.     print STDERR "$progname: no files in $dir\n";
  354.     exit 1;
  355.   }
  356.  
  357.   my $max_tries = 50;
  358.   for (my $i = 0; $i < $max_tries; $i++) {
  359.  
  360.     my $n = int (rand ($#all_files + 1));
  361.     my $file = $all_files[$n];
  362.     if (large_enough_p ($file)) {
  363.       return $file;
  364.     }
  365.   }
  366.  
  367.   print STDERR "$progname: no suitable images in $dir " .
  368.                "(after $max_tries tries)\n";
  369.   exit 1;
  370. }
  371.  
  372.  
  373. sub large_enough_p {
  374.   my ($file) = @_;
  375.  
  376.   my ($w, $h) = image_file_size ($file);
  377.  
  378.   if (!defined ($h)) {
  379.     print STDERR "$progname: $file: unable to determine image size\n"
  380.       if ($verbose);
  381.     # Assume that unknown files are of good sizes: this will happen if
  382.     # they matched $good_file_re, but we don't have code to parse them.
  383.     # (This will also happen if the file is junk...)
  384.     return 1;
  385.   }
  386.  
  387.   if ($w < $min_image_width || $h < $min_image_height) {
  388.     print STDERR "$progname: $file: too small ($w x $h)\n" if ($verbose);
  389.     return 0;
  390.   }
  391.  
  392.   print STDERR "$progname: $file: $w x $h\n" if ($verbose);
  393.   return 1;
  394. }
  395.  
  396.  
  397.  
  398. # Given the raw body of a GIF document, returns the dimensions of the image.
  399. #
  400. sub gif_size {
  401.   my ($body) = @_;
  402.   my $type = substr($body, 0, 6);
  403.   my $s;
  404.   return () unless ($type =~ /GIF8[7,9]a/);
  405.   $s = substr ($body, 6, 10);
  406.   my ($a,$b,$c,$d) = unpack ("C"x4, $s);
  407.   return (($b<<8|$a), ($d<<8|$c));
  408. }
  409.  
  410. # Given the raw body of a JPEG document, returns the dimensions of the image.
  411. #
  412. sub jpeg_size {
  413.   my ($body) = @_;
  414.   my $i = 0;
  415.   my $L = length($body);
  416.  
  417.   my $c1 = substr($body, $i, 1); $i++;
  418.   my $c2 = substr($body, $i, 1); $i++;
  419.   return () unless (ord($c1) == 0xFF && ord($c2) == 0xD8);
  420.  
  421.   my $ch = "0";
  422.   while (ord($ch) != 0xDA && $i < $L) {
  423.     # Find next marker, beginning with 0xFF.
  424.     while (ord($ch) != 0xFF) {
  425.       return () if (length($body) <= $i);
  426.       $ch = substr($body, $i, 1); $i++;
  427.     }
  428.     # markers can be padded with any number of 0xFF.
  429.     while (ord($ch) == 0xFF) {
  430.       return () if (length($body) <= $i);
  431.       $ch = substr($body, $i, 1); $i++;
  432.     }
  433.  
  434.     # $ch contains the value of the marker.
  435.     my $marker = ord($ch);
  436.  
  437.     if (($marker >= 0xC0) &&
  438.         ($marker <= 0xCF) &&
  439.         ($marker != 0xC4) &&
  440.         ($marker != 0xCC)) {  # it's a SOFn marker
  441.       $i += 3;
  442.       return () if (length($body) <= $i);
  443.       my $s = substr($body, $i, 4); $i += 4;
  444.       my ($a,$b,$c,$d) = unpack("C"x4, $s);
  445.       return (($c<<8|$d), ($a<<8|$b));
  446.  
  447.     } else {
  448.       # We must skip variables, since FFs in variable names aren't
  449.       # valid JPEG markers.
  450.       return () if (length($body) <= $i);
  451.       my $s = substr($body, $i, 2); $i += 2;
  452.       my ($c1, $c2) = unpack ("C"x2, $s);
  453.       my $length = ($c1 << 8) | $c2;
  454.       return () if ($length < 2);
  455.       $i += $length-2;
  456.     }
  457.   }
  458.   return ();
  459. }
  460.  
  461. # Given the raw body of a PNG document, returns the dimensions of the image.
  462. #
  463. sub png_size {
  464.   my ($body) = @_;
  465.   return () unless ($body =~ m/^\211PNG\r/s);
  466.   my ($bits) = ($body =~ m/^.{12}(.{12})/s);
  467.   return () unless defined ($bits);
  468.   return () unless ($bits =~ /^IHDR/);
  469.   my ($ign, $w, $h) = unpack("a4N2", $bits);
  470.   return ($w, $h);
  471. }
  472.  
  473.  
  474. # Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions
  475. # of the image.
  476. #
  477. sub image_size {
  478.   my ($body) = @_;
  479.   return () if (length($body) < 10);
  480.   my ($w, $h) = gif_size ($body);
  481.   if ($w && $h) { return ($w, $h); }
  482.   ($w, $h) = jpeg_size ($body);
  483.   if ($w && $h) { return ($w, $h); }
  484.   # #### TODO: need image parsers for TIFF, XPM, XBM.
  485.   return png_size ($body);
  486. }
  487.  
  488. # Returns the dimensions of the image file.
  489. #
  490. sub image_file_size {
  491.   my ($file) = @_;
  492.   local *IN;
  493.   if (! open (IN, "<$file")) {
  494.     print STDERR "$progname: $file: $!\n" if ($verbose);
  495.     return undef;
  496.   }
  497.   binmode (IN);  # Larry can take Unicode and shove it up his ass sideways.
  498.   my $body = '';
  499.   sysread (IN, $body, 1024 * 50);   # The first 50k should be enough.
  500.   close IN;                # (It's not for certain huge jpegs...
  501.   return image_size ($body);        # but we know they're huge!)
  502. }
  503.  
  504.  
  505. sub error($) {
  506.   my ($err) = @_;
  507.   print STDERR "$progname: $err\n";
  508.   exit 1;
  509. }
  510.  
  511. sub usage {
  512.   print STDERR "usage: $progname [--verbose] directory\n" .
  513.   "       Prints the name of a randomly-selected image file.  The directory\n" .
  514.   "       is searched recursively.  Images smaller than " .
  515.          "${min_image_width}x${min_image_height} are excluded.\n";
  516.   exit 1;
  517. }
  518.  
  519. sub main {
  520.   my $dir = undef;
  521.  
  522.   while ($_ = $ARGV[0]) {
  523.     shift @ARGV;
  524.     if ($_ eq "--verbose") { $verbose++; }
  525.     elsif (m/^-v+$/) { $verbose += length($_)-1; }
  526.     elsif ($_ eq "--name") { }     # ignored, for compatibility
  527.     elsif ($_ eq "--spotlight")    { $use_spotlight_p = 1; }
  528.     elsif ($_ eq "--no-spotlight") { $use_spotlight_p = 0; }
  529.     elsif ($_ eq "--cache")        { $cache_p = 1; }
  530.     elsif ($_ eq "--no-cache")     { $cache_p = 0; }
  531.     elsif (m/^-./) { usage; }
  532.     elsif (!defined($dir)) { $dir = $_; }
  533.     else { usage; }
  534.   }
  535.  
  536.   usage unless (defined($dir));
  537.  
  538.   $dir =~ s@^~/@$ENV{HOME}/@s;     # allow literal "~/"
  539.  
  540.   if (! -d $dir) {
  541.     print STDERR "$progname: $dir: not a directory\n";
  542.     usage;
  543.   }
  544.  
  545.   my $file = find_random_file ($dir);
  546.   print STDOUT "$file\n";
  547. }
  548.  
  549. main;
  550. exit 0;
  551.