git.hungrycats.org Git - xscreensaver/blob - driver/xscreensaver-getimage-file

   1 #!/usr/bin/perl -w
   2 # Copyright © 2001, 2002, 2003, 2004 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 attempts to locate a random image from the specified directory,
  13 # and load it on to the root window, using some other program that can decode
  14 # image files.  (It attempts to find such a program.)
  15 #
  16 # The various xscreensaver hacks that manipulate images ("slidescreen",
  17 # "jigsaw", etc.) get the image to manipulate by running the
  18 # "xscreensaver-getimage" program.
  19 #
  20 # "xscreensaver-getimage" will invoke this program, depending on the
  21 # value of the "chooseRandomImages" and "imageDirectory" settings in
  22 # the ~/.xscreensaver file (or /usr/lib/X11/app-defaults/XScreenSaver).
  23 #
  24 # Created: 12-Apr-01.
  25
  26 require 5;
  27 use diagnostics;
  28 use strict;
  29
  30 use POSIX;
  31 use Fcntl;
  32
  33 use POSIX ':fcntl_h';                           # S_ISLNK was here in Perl 5.6
  34 import Fcntl ':mode' unless defined &S_ISLNK;   # but it is here in Perl 5.8
  35
  36
  37 my $progname = $0; $progname =~ s@.*/@@g;
  38 my $version = q{ $Revision: 1.16 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
  39
  40 my $verbose = 0;
  41
  42 # This matches files that we are allowed to use as images (case-insensitive.)
  43 # Anything not matching this is ignored.  This is so you can point your
  44 # imageDirectory at directory trees that have things other than images in
  45 # them, but it assumes that you gave your images sensible file extensions.
  46 #
  47 my $good_file_re = '\.(gif|p?jpe?g|png|tiff?|xbm|xpm)$';
  48
  49 # JPEG, GIF, and PNG files that are are smaller than this size in either
  50 # direction are rejected: this is so that you can use an image directory
  51 # that contains both big images and thumbnails, and have it only select
  52 # the big versions.
  53 #
  54 my $min_image_width  = 255;
  55 my $min_image_height = 255;
  56
  57
  58 # These are programs that can be used to put an image file on the root
  59 # window (including virtual root windows.)  The first one of these programs
  60 # that exists on $PATH will be used (with the file name as the last arg.)
  61 #
  62 # Generally this isn't used any more; when "xscreensaver-getimage" invokes
  63 # this program, it does so with the "-file" argument (meaning that we just
  64 # return the file name) and then xscreensaver-getimage loads that file
  65 # directly.  However, if you invoke "xscreensaver-getimage-file" directly,
  66 # without "-file", this will be used to actually load the image.
  67 #
  68 my @programs = (
  69   "chbg       -once -xscreensaver -max_grow 4 -max_size 100",
  70   "xv         -root -quit -viewonly -maxpect +noresetroot -quick24 -rmode 5" .
  71   "           -rfg black -rbg black",
  72   "xli        -quiet -fullscreen -onroot -center -border black",
  73   "xloadimage -quiet -fullscreen -onroot -center -border black",
  74
  75 # this lame program wasn't built with vroot.h:
  76 # "xsri       -scale -keep-aspect -center-horizontal -center-vertical",
  77 );
  78
  79
  80 sub pick_displayer {
  81   my @names = ();
  82
  83   foreach my $cmd (@programs) {
  84     $_ = $cmd;
  85     my ($name) = m/^([^ ]+)/;
  86     push @names, "\"$name\"";
  87     print STDERR "$progname: looking for $name...\n" if ($verbose > 2);
  88     foreach my $dir (split (/:/, $ENV{PATH})) {
  89       print STDERR "$progname:   checking $dir/$name\n" if ($verbose > 3);
  90       return $cmd if (-x "$dir/$name");
  91     }
  92   }
  93
  94   $names[$#names] = "or " . $names[$#names];
  95   printf STDERR "$progname: none of: " . join (", ", @names) .
  96                 " were found on \$PATH.\n";
  97   exit 1;
  98 }
  99
 100
 101 my @all_files = ();     # list of "good" files we've collected
 102 my %seen_inodes;        # for breaking recursive symlink loops
 103 my $skip_count = 0;     # number of files skipped, for diagnostic messages
 104 my $dir_count = 1;      # number of directories seen, for diagnostic messages
 105
 106 sub find_all_files {
 107   my ($dir) = @_;
 108
 109   print STDERR "$progname: reading dir $dir/...\n" if ($verbose > 2);
 110
 111   local *DIR;
 112   if (! opendir (DIR, $dir)) {
 113     print STDERR "$progname: couldn't open $dir: $!\n" if ($verbose);
 114     return;
 115   }
 116   my @files = readdir (DIR);
 117   closedir (DIR);
 118
 119   my @dirs = ();
 120
 121   foreach my $file (@files) {
 122     next if ($file =~ m/^\./);      # ignore dot files/dirs
 123
 124     $file = "$dir/$file";
 125     my @st = stat($file);
 126     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
 127         $atime,$mtime,$ctime,$blksize,$blocks) = @st;
 128
 129     if ($#st == -1) {
 130       if ($verbose) {
 131         my $ll = readlink $file;
 132         if (defined ($ll)) {
 133           print STDERR "$progname: dangling symlink: $file -> $ll\n";
 134         } else {
 135           print STDERR "$progname: unreadable: $file\n";
 136         }
 137       }
 138       next;
 139     }
 140
 141     next if ($seen_inodes{"$dev:$ino"}); # break symlink loops
 142     $seen_inodes{"$dev:$ino"} = 1;
 143
 144     if (S_ISDIR($mode)) {
 145       push @dirs, $file;
 146       $dir_count++;
 147       print STDERR "$progname:   found dir  $file\n" if ($verbose > 2);
 148     } elsif (S_ISREG($mode) || S_ISLNK($mode)) {
 149
 150       if ($file =~ m/[~%\#]$/ ||               # backup file, or
 151           ! ($file =~ m/$good_file_re/io)) {   # no image extension
 152         $skip_count++;
 153         print STDERR "$progname:   skip file $file\n" if ($verbose > 2);
 154       } else {
 155         push @all_files, $file;
 156         print STDERR "$progname:   found file $file\n" if ($verbose > 2);
 157       }
 158     } elsif ($verbose > 2) {
 159       print STDERR "$progname:   nonreg $file\n";
 160     }
 161   }
 162
 163   foreach (@dirs) {
 164     find_all_files ($_);
 165   }
 166 }
 167
 168
 169 sub find_random_file {
 170   my ($dir) = @_;
 171
 172   $dir =~ s@/+$@@g;
 173
 174   print STDERR "$progname: recursively reading $dir...\n" if ($verbose > 1);
 175   find_all_files ($dir);
 176   print STDERR "$progname: found " . ($#all_files+1) .
 177                " file" . ($#all_files == 0 ? "" : "s") .
 178                " in $dir_count dir" . ($dir_count == 1 ? "" : "s") .
 179                "; skipped $skip_count file" . ($skip_count == 1 ? "" : "s") .
 180                ".\n"
 181     if ($verbose > 1);
 182
 183   @all_files = sort(@all_files);
 184
 185   if ($#all_files < 0) {
 186     print STDERR "$progname: no files in $dir\n";
 187     exit 1;
 188   }
 189
 190   my $max_tries = 50;
 191   for (my $i = 0; $i < $max_tries; $i++) {
 192
 193     my $n = int (rand ($#all_files + 1));
 194     my $file = $all_files[$n];
 195     if (large_enough_p ($file)) {
 196       return $file;
 197     }
 198   }
 199
 200   print STDERR "$progname: no suitable images in $dir " .
 201                "(after $max_tries tries)\n";
 202   exit 1;
 203 }
 204
 205
 206 sub display_file {
 207   my ($file, $displayer) = @_;
 208
 209   if (!defined($displayer)) {
 210     print STDOUT "$file\n";
 211   }  else {
 212     my @cmd = split (/ +/, $displayer);
 213     push @cmd, $file;   # do it this way to allow file names with spaces.
 214     print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
 215       if ($verbose);
 216     exec (@cmd) || die;
 217   }
 218 }
 219
 220
 221 sub find_and_display {
 222   my ($dir, $displayer) = @_;
 223   my $file = find_random_file ($dir);
 224   display_file ($file, $displayer);
 225 }
 226
 227
 228 sub large_enough_p {
 229   my ($file) = @_;
 230
 231   my ($w, $h) = image_file_size ($file);
 232
 233   if (!defined ($h)) {
 234     print STDERR "$progname: $file: unable to determine image size\n"
 235       if ($verbose);
 236     # Assume that unknown files are of good sizes: this will happen if
 237     # they matched $good_file_re, but we don't have code to parse them.
 238     # (This will also happen if the file is junk...)
 239     return 1;
 240   }
 241
 242   if ($w < $min_image_width || $h < $min_image_height) {
 243     print STDERR "$progname: $file: too small ($w x $h)\n" if ($verbose > 1);
 244     return 0;
 245   }
 246
 247   print STDERR "$progname: $file: $w x $h\n" if ($verbose > 1);
 248   return 1;
 249 }
 250
 251
 252
 253 # Given the raw body of a GIF document, returns the dimensions of the image.
 254 #
 255 sub gif_size {
 256   my ($body) = @_;
 257   my $type = substr($body, 0, 6);
 258   my $s;
 259   return () unless ($type =~ /GIF8[7,9]a/);
 260   $s = substr ($body, 6, 10);
 261   my ($a,$b,$c,$d) = unpack ("C"x4, $s);
 262   return (($b<<8|$a), ($d<<8|$c));
 263 }
 264
 265 # Given the raw body of a JPEG document, returns the dimensions of the image.
 266 #
 267 sub jpeg_size {
 268   my ($body) = @_;
 269   my $i = 0;
 270   my $L = length($body);
 271
 272   my $c1 = substr($body, $i, 1); $i++;
 273   my $c2 = substr($body, $i, 1); $i++;
 274   return () unless (ord($c1) == 0xFF && ord($c2) == 0xD8);
 275
 276   my $ch = "0";
 277   while (ord($ch) != 0xDA && $i < $L) {
 278     # Find next marker, beginning with 0xFF.
 279     while (ord($ch) != 0xFF) {
 280       return () if (length($body) <= $i);
 281       $ch = substr($body, $i, 1); $i++;
 282     }
 283     # markers can be padded with any number of 0xFF.
 284     while (ord($ch) == 0xFF) {
 285       return () if (length($body) <= $i);
 286       $ch = substr($body, $i, 1); $i++;
 287     }
 288
 289     # $ch contains the value of the marker.
 290     my $marker = ord($ch);
 291
 292     if (($marker >= 0xC0) &&
 293         ($marker <= 0xCF) &&
 294         ($marker != 0xC4) &&
 295         ($marker != 0xCC)) {  # it's a SOFn marker
 296       $i += 3;
 297       return () if (length($body) <= $i);
 298       my $s = substr($body, $i, 4); $i += 4;
 299       my ($a,$b,$c,$d) = unpack("C"x4, $s);
 300       return (($c<<8|$d), ($a<<8|$b));
 301
 302     } else {
 303       # We must skip variables, since FFs in variable names aren't
 304       # valid JPEG markers.
 305       return () if (length($body) <= $i);
 306       my $s = substr($body, $i, 2); $i += 2;
 307       my ($c1, $c2) = unpack ("C"x2, $s);
 308       my $length = ($c1 << 8) | $c2;
 309       return () if ($length < 2);
 310       $i += $length-2;
 311     }
 312   }
 313   return ();
 314 }
 315
 316 # Given the raw body of a PNG document, returns the dimensions of the image.
 317 #
 318 sub png_size {
 319   my ($body) = @_;
 320   return () unless ($body =~ m/^\211PNG\r/);
 321   my ($bits) = ($body =~ m/^.{12}(.{12})/s);
 322   return () unless defined ($bits);
 323   return () unless ($bits =~ /^IHDR/);
 324   my ($ign, $w, $h) = unpack("a4N2", $bits);
 325   return ($w, $h);
 326 }
 327
 328
 329 # Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions
 330 # of the image.
 331 #
 332 sub image_size {
 333   my ($body) = @_;
 334   my ($w, $h) = gif_size ($body);
 335   if ($w && $h) { return ($w, $h); }
 336   ($w, $h) = jpeg_size ($body);
 337   if ($w && $h) { return ($w, $h); }
 338   # #### TODO: need image parsers for TIFF, XPM, XBM.
 339   return png_size ($body);
 340 }
 341
 342 # Returns the dimensions of the image file.
 343 #
 344 sub image_file_size {
 345   my ($file) = @_;
 346   my $body = '';
 347   local *IN;
 348   if (! open (IN, "<$file")) {
 349     print STDERR "$progname: $file: $!\n" if ($verbose);
 350     return undef;
 351   }
 352   while (<IN>) {
 353     $body .= $_;
 354     last if (length($body) > 1024 * 100);  # the first 100k should be enough
 355   }
 356   close IN;
 357   return image_size ($body);
 358 }
 359
 360
 361 sub usage {
 362   print STDERR "usage: $progname [--verbose] [--name] file-or-directory\n\n" .
 363   "       Puts the given image file (or a randomly selected image from the\n" .
 364   "       given directory) on the root window.  If --name is specified,\n" .
 365   "       just prints the selected filename to stdout instead.\n\n";
 366   exit 1;
 367 }
 368
 369 sub main {
 370   my $dir = undef;
 371   my $do_name = 0;
 372
 373   while ($_ = $ARGV[0]) {
 374     shift @ARGV;
 375     if ($_ eq "--verbose") { $verbose++; }
 376     elsif (m/^-v+$/) { $verbose += length($_)-1; }
 377     elsif ($_ eq "--name") { $do_name++; }
 378     elsif (m/^-./) { usage; }
 379     elsif (!defined($dir)) { $dir = $_; }
 380     else { usage; }
 381   }
 382
 383   usage unless (defined($dir));
 384   my $displayer = undef;
 385
 386   $displayer = pick_displayer() unless $do_name;
 387
 388   if (-d $dir) {
 389     find_and_display ($dir, $displayer);
 390   } elsif (-f $dir) {
 391     display_file ($dir, $displayer);
 392   } else {
 393     print STDERR "$progname: $dir does not exist\n";
 394     usage();
 395   }
 396 }
 397
 398 main;
 399 exit 0;