X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?p=xscreensaver;a=blobdiff_plain;f=driver%2Fxscreensaver-text;h=52f9f577b16562a82321686b6ecee4197f3f11e2;hp=52be88b73d3643a9e2dccd35ca5946b106036752;hb=3f438031d610c7e15fd33876a879b97e290e05fb;hpb=447db08c956099b3b183886729108bf5b364c4b8 diff --git a/driver/xscreensaver-text b/driver/xscreensaver-text index 52be88b7..52f9f577 100755 --- a/driver/xscreensaver-text +++ b/driver/xscreensaver-text @@ -24,7 +24,7 @@ use Text::Wrap qw(wrap); use bytes; my $progname = $0; $progname =~ s@.*/@@g; -my $version = q{ $Revision: 1.3 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; +my $version = q{ $Revision: 1.5 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $verbose = 0; my $http_proxy = undef; @@ -108,7 +108,7 @@ my %unicode_latin1_table = ( # Convert any HTML entities to Latin1 characters. # -sub de_entify { +sub de_entify($) { my ($text) = @_; $text =~ s/(&(\#)?([[:alpha:]\d]+);?)/ { @@ -130,7 +130,7 @@ sub de_entify { # Convert any Unicode characters to Latin1 if possible. # Unconvertable bytes are left alone. # -sub de_unicoddle { +sub de_unicoddle($) { my ($text) = @_; foreach my $key (keys (%unicode_latin1_table)) { my $val = $unicode_latin1_table{$key}; @@ -142,7 +142,7 @@ sub de_unicoddle { # Reads the prefs we use from ~/.xscreensaver # -sub get_prefs { +sub get_prefs() { my $got_any_p = 0; local *IN; @@ -181,7 +181,7 @@ sub get_prefs { } -sub get_prefs_1 { +sub get_prefs_1($) { my ($body) = @_; my $got_any_p = 0; @@ -210,7 +210,7 @@ sub get_prefs_1 { # like system() but checks errors. # -sub safe_system { +sub safe_system(@) { my (@cmd) = @_; print STDERR "$progname: executing " . join(' ', @cmd) . "\n" @@ -226,7 +226,7 @@ sub safe_system { } -sub which { +sub which($) { my ($cmd) = @_; if ($cmd =~ m@^\./|^/@) { @@ -243,7 +243,7 @@ sub which { } -sub output { +sub output() { # Do some basic sanity checking (null text, null file names, etc.) # @@ -317,7 +317,7 @@ sub output { # Loads the given URL, returns: $http, $head, $body. # -sub get_url_1 { +sub get_url_1($;$) { my ($url, $referer) = @_; if (! ($url =~ m@^http://@i)) { @@ -418,7 +418,7 @@ sub get_url_1 { # Loads the given URL, processes redirects, returns (content-type, body). # -sub get_url { +sub get_url($;$) { my ($url, $referer) = @_; print STDERR "$progname: loading $url\n" if ($verbose > 2); @@ -479,7 +479,7 @@ sub get_url { # We don't necessarily take the Content-Type header at face value. # Returns 'html', 'rss', or 'text'; # -sub guess_content_type { +sub guess_content_type($$) { my ($ct, $body) = @_; $body =~ s/^(.{512}).*/$1/s; # only look in first half K of file @@ -502,7 +502,7 @@ sub guess_content_type { return 'text'; } -sub reformat_html { +sub reformat_html($$) { my ($body, $rss_p) = @_; $_ = $body; @@ -544,11 +544,15 @@ sub reformat_html { } -sub reformat_rss { +sub reformat_rss($) { my ($body) = @_; $body =~ s/(<(ITEM|ENTRY)\b)/\001\001$1/gsi; my @items = split (/\001\001/, $body); + + print STDERR "$progname: converting RSS ($#items items)...\n" + if ($verbose > 2); + shift @items; # Let's skip forward in the stream by a random amount, so that if @@ -556,32 +560,48 @@ sub reformat_rss { # multi-headed machine), they get different text. (Put the items # that we take off the front back on the back.) # - if ($#items > 10) { + if ($#items > 7) { my $n = int (rand ($#items - 5)); + print STDERR "$progname: rotating by $n items...\n" if ($verbose > 2); while ($n-- > 0) { push @items, (shift @items); } } - my $i = 0; + my $i = -1; foreach (@items) { + $i++; - my ($title, $body1, $body2); + my ($title, $body1, $body2, $body3); - $title = $2 if (m@<(TITLE [^<>\s]*)[^<>]*>\s*(.*?)\s*@xsi); - $body1 = $3 if (m@<((DESCRIPTION) [^<>\s]*)[^<>]*>\s*(.*?)\s*@xsi); - $body2 = $3 if (m@<((CONTENT) [^<>\s]*)[^<>]*>\s*(.*?)\s*@xsi); + $title = $3 if (m@<((TITLE) [^<>\s]*)[^<>]*>\s*(.*?)\s*@xsi); + $body1 = $3 if (m@<((DESCRIPTION) [^<>\s]*)[^<>]*>\s*(.*?)\s*@xsi); + $body2 = $3 if (m@<((CONTENT) [^<>\s]*)[^<>]*>\s*(.*?)\s*@xsi); + $body3 = $3 if (m@<((SUMMARY) [^<>\s]*)[^<>]*>\s*(.*?)\s*@xsi); # If there are both and or , # use whichever one contains more text. # - if ($body1 && $body2 && length($body2) >= length($body1)) { + if ($body3 && length($body3) >= length($body2 || '')) { + $body2 = $body3; + } + if ($body2 && length($body2) >= length($body1 || '')) { $body1 = $body2; } - next unless defined ($body1); - $title = rss_field_to_html ($title); - $body1 = rss_field_to_html ($body1); + if (! $body1) { + if ($title) { + print STDERR "$progname: no body in item $i (\"$title\")\n" + if ($verbose > 2); + } else { + print STDERR "$progname: no body or title in item $i\n" + if ($verbose > 2); + next; + } + } + + $title = rss_field_to_html ($title || ''); + $body1 = rss_field_to_html ($body1 || ''); reformat_html ("$title

$body1", 1); print "\n"; @@ -589,7 +609,7 @@ sub reformat_rss { } -sub rss_field_to_html { +sub rss_field_to_html($) { my ($body) = @_; # Assume that if is present, everything inside that. @@ -605,7 +625,7 @@ sub rss_field_to_html { } -sub reformat_text { +sub reformat_text($) { my ($body) = @_; # only re-wrap if --cols was specified. Otherwise, dump it as is. @@ -621,7 +641,7 @@ sub reformat_text { } -sub get_url_text { +sub get_url_text($) { my ($url) = @_; # historical suckage: the environment variable name is lower case. @@ -639,7 +659,6 @@ sub get_url_text { print STDERR "$progname: converting HTML...\n" if ($verbose > 2); reformat_html ($body, 0); } elsif ($ct eq 'rss') { - print STDERR "$progname: converting RSS...\n" if ($verbose > 2); reformat_rss ($body); } else { print STDERR "$progname: plain text...\n" if ($verbose > 2); @@ -649,13 +668,13 @@ sub get_url_text { -sub error { +sub error($) { my ($err) = @_; print STDERR "$progname: $err\n"; exit 1; } -sub usage { +sub usage() { print STDERR "usage: $progname [ --options ... ]\n" . ("\n" . " Prints out some text for use by various screensavers,\n" . @@ -686,7 +705,7 @@ sub usage { exit 1; } -sub main { +sub main() { my $load_p = 1; @@ -717,5 +736,5 @@ sub main { output(); } -main; +main(); exit 0;