my $progname = $0; $progname =~ s@.*/@@g;
-my $version = q{ $Revision: 1.35 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $version = q{ $Revision: 1.37 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
my $verbose = 0;
my $dd = "$ENV{HOME}/Library/Caches"; # MacOS location
if (-d $dd) {
$cache_file_name = "$dd/org.jwz.xscreensaver.getimage.cache";
- } elsif (-d "$ENV{HOME}/tmp") {
+ } elsif (-d "$ENV{HOME}/.cache") { # Gnome "FreeDesktop XDG" location
+ $dd = "$ENV{HOME}/.cache/xscreensaver";
+ if (! -d $dd) { mkdir ($dd) || error ("mkdir $dd: $!"); }
+ $cache_file_name = "$dd/xscreensaver-getimage.cache"
+ } elsif (-d "$ENV{HOME}/tmp") { # If ~/.tmp/ exists, use it.
$cache_file_name = "$ENV{HOME}/tmp/.xscreensaver-getimage.cache";
} else {
$cache_file_name = "$ENV{HOME}/.xscreensaver-getimage.cache";
print $cache_fd "$dir\n";
foreach (@all_files) {
my $f = $_; # stupid Perl. do this to avoid modifying @all_files!
- $f =~ s@^\Q$dir\L/@@so || die; # remove $dir from front
+ $f =~ s@^\Q$dir/@@so || die; # remove $dir from front
print $cache_fd "$f\n";
}
}
if ($body !~ m@^<\?xml\s@si) {
# Not an RSS/Atom feed. Try RSS autodiscovery.
+ # (Great news, everybody: Flickr no longer provides RSS for "Sets",
+ # only for "Photostreams", and only the first 20 images of those.
+ # Thanks, assholes.)
+
error ("not an RSS or Atom feed, or HTML: $url")
unless ($body =~ m@<(HEAD|BODY|A|IMG)\b@si);
$p =~ m! \b HREF \s* = \s* ['"] ( [^<>'"]+ ) !six
) {
my $u2 = html_unquote ($1);
+ if ($u2 =~ m!^/!s) {
+ my ($h) = ($url =~ m!^([a-z]+://[^/]+)!si);
+ $u2 = "$h$u2";
+ }
print STDERR "$progname: found feed: $u2\n"
if ($verbose);
return parse_feed ($u2);
sub download_image($$$) {
my ($url, $uid, $dir) = @_;
- my ($ext) = ($url =~ m@\.([a-z\d]+)$@si);
+ my $url2 = $url;
+ $url2 =~ s/\#.*$//s; # Omit search terms after file extension
+ $url2 =~ s/\?.*$//s;
+ my ($ext) = ($url2 =~ m@\.([a-z\d]+)$@si);
+
+ # If the feed hasn't put a sane extension on their URLs, nothing's going
+ # to work. This code assumes that file names have extensions, even the
+ # ones in the cache directory.
+ #
+ if (! $ext) {
+ print STDERR "$progname: skipping extensionless URL: $url\n"
+ if ($verbose > 1);
+ return undef;
+ }
+
+ # Don't bother downloading files that we will reject anyway.
+ #
+ if (! ($url2 =~ m/$good_file_re/io)) {
+ print STDERR "$progname: skipping non-image URL: $url\n"
+ if ($verbose > 1);
+ return undef;
+ }
+
my $file = md5_file ($uid);
$file .= '.' . lc($ext) if $ext;
# Special-case kludge for Flickr:
# Their RSS feeds sometimes include only the small versions of the images.
- # So if the URL ends in "s" (75x75), "t" (100x100) or "m" (240x240),then
- # munge it to be "b" (1024x1024).
+ # So if the URL ends in one of the "small-size" letters, change it to "b".
#
- $url =~ s@_[stm](\.[a-z]+)$@_b$1@si
+ # _o orig, 1600 +
+ # _k large, 2048 max
+ # _h large, 1600 max
+ # _b large, 1024 max
+ # _c medium, 800 max
+ # _z medium, 640 max
+ # "" medium, 500 max
+ # _n small, 320 max
+ # _m small, 240 max
+ # _t thumb, 100 max
+ # _q square, 150x150
+ # _s square, 75x75
+ #
+ $url =~ s@_[sqtmnzc](\.[a-z]+)$@_b$1@si
if ($url =~ m@^https?://[^/?#&]*?flickr\.com/@si);
print STDERR "$progname: downloading: $dir/$file for $uid / $url\n"
my $dir = "$ENV{HOME}/Library/Caches"; # MacOS location
if (-d $dir) {
$dir = "$dir/org.jwz.xscreensaver.feeds";
- } elsif (-d "$ENV{HOME}/tmp") {
+ } elsif (-d "$ENV{HOME}/.cache") { # Gnome "FreeDesktop XDG" location
+ $dir = "$ENV{HOME}/.cache/xscreensaver";
+ if (! -d $dir) { mkdir ($dir) || error ("mkdir $dir: $!"); }
+ $dir .= "/feeds";
+ if (! -d $dir) { mkdir ($dir) || error ("mkdir $dir: $!"); }
+ } elsif (-d "$ENV{HOME}/tmp") { # If ~/.tmp/ exists, use it.
$dir = "$ENV{HOME}/tmp/.xscreensaver-feeds";
} else {
$dir = "$ENV{HOME}/.xscreensaver-feeds";
my $poll_p = ($mtime + $feed_max_age < time);
- $poll_p = 1 unless ($cache_p); # poll again now with --no-cache cmd line arg.
+ # --no-cache cmd line arg means poll again right now.
+ $poll_p = 1 unless ($cache_p);
- # Even if the cache is young, let's make sure there are at least
- # a few files in it, and re-check if not.
+ # Even if the cache is young, make sure there is at least one file,
+ # and re-check if not.
#
if (! $poll_p) {
my $count = 0;
$count++;
}
- print STDERR "$progname: empty feed: $url\n" if ($count <= 0);
+ my $empty_p = ($count <= 0);
# Now delete any files that are no longer in the feed.
# But if there was nothing in the feed (network failure?)
}
}
- # Both feed and cache are empty. No files at all.
+ # Both feed and cache are empty. No files at all. Bail.
error ("empty feed: $url") if ($kept <= 1);
+ # Feed is empty, but we have some files from last time. Warn.
+ print STDERR "$progname: empty feed: using cache: $url\n"
+ if ($empty_p);
+
$mtime = time(); # update the timestamp
} else {
write_cache ($dir);
-# @all_files = sort(@all_files);
-
if ($#all_files < 0) {
print STDERR "$progname: no files in $dir\n";
exit 1;
my $file = $all_files[$n];
if (large_enough_p ($file)) {
if (! $url) {
- $file =~ s@^\Q$dir\L/@@so || die; # remove $dir from front
+ $file =~ s@^\Q$dir/@@so || die; # remove $dir from front
}
return $file;
}
sub image_file_size($) {
my ($file) = @_;
my $in;
- if (! open ($in, '<', $file)) {
+ if (! open ($in, '<:raw', $file)) {
print STDERR "$progname: $file: $!\n" if ($verbose);
return ();
}
- binmode ($in); # Larry can take Unicode and shove it up his ass sideways.
my $body = '';
sysread ($in, $body, 1024 * 50); # The first 50k should be enough.
close $in; # (It's not for certain huge jpegs...
}
sub usage() {
- print STDERR "usage: $progname [--verbose] directory\n" .
+ print STDERR "usage: $progname [--verbose] directory-or-feed-url\n\n" .
" Prints the name of a randomly-selected image file. The directory\n" .
" is searched recursively. Images smaller than " .
"${min_image_width}x${min_image_height} are excluded.\n" .
while ($_ = $ARGV[0]) {
shift @ARGV;
- if ($_ eq "--verbose") { $verbose++; }
- elsif (m/^-v+$/) { $verbose += length($_)-1; }
- elsif ($_ eq "--name") { } # ignored, for compatibility
- elsif ($_ eq "--spotlight") { $use_spotlight_p = 1; }
- elsif ($_ eq "--no-spotlight") { $use_spotlight_p = 0; }
- elsif ($_ eq "--cache") { $cache_p = 1; }
- elsif ($_ eq "--no-cache") { $cache_p = 0; }
- elsif (m/^-./) { usage; }
- elsif (!defined($dir)) { $dir = $_; }
- else { usage; }
+ if (m/^--?verbose$/s) { $verbose++; }
+ elsif (m/^-v+$/s) { $verbose += length($_)-1; }
+ elsif (m/^--?name$/s) { } # ignored, for compatibility
+ elsif (m/^--?spotlight$/s) { $use_spotlight_p = 1; }
+ elsif (m/^--?no-spotlight$/s) { $use_spotlight_p = 0; }
+ elsif (m/^--?cache$/s) { $cache_p = 1; }
+ elsif (m/^--?no-?cache$/s) { $cache_p = 0; }
+ elsif (m/^-./) { usage; }
+ elsif (!defined($dir)) { $dir = $_; }
+ else { usage; }
}
usage unless (defined($dir));
projects / xscreensaver / blobdiff