home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / bin / xscreensaver-text < prev    next >
Encoding:
Text File  |  2007-02-07  |  21.6 KB  |  751 lines
  1. #!/usr/bin/perl -w
  2. # Copyright ⌐ 2005 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 writes some text to stdout, based on preferences in the
  13. # .xscreensaver file.  It may load a file, a URL, run a program, or just
  14. # print the date.
  15. #
  16. # Created: 19-Mar-2005.
  17.  
  18. require 5;
  19. use diagnostics;
  20. use strict;
  21. use Socket;
  22. use POSIX qw(strftime);
  23. use Text::Wrap qw(wrap);
  24. use bytes;
  25.  
  26. my $progname = $0; $progname =~ s@.*/@@g;
  27. my $version = q{ $Revision: 1.7 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
  28.  
  29. my $verbose = 0;
  30. my $http_proxy = undef;
  31.  
  32. my $config_file = $ENV{HOME} . "/.xscreensaver";
  33. my $text_mode     = 'date';
  34. my $text_literal  = '';
  35. my $text_file     = '';
  36. my $text_program  = '';
  37. my $text_url      = '';
  38.  
  39. my $wrap_columns  = undef;
  40.  
  41.  
  42. # Maps HTML character entities to the corresponding Latin1 characters.
  43. #
  44. my %entity_table = (
  45.    "quot"   => '"', "amp"    => '&', "lt"     => '<', "gt"     => '>',
  46.    "nbsp"   => ' ', "iexcl"  => 'í', "cent"   => 'ó', "pound"  => 'ú',
  47.    "curren" => 'ñ', "yen"    => 'Ñ', "brvbar" => 'ª', "sect"   => 'º',
  48.    "uml"    => '¿', "copy"   => '⌐', "ordf"   => '¬', "laquo"  => '½',
  49.    "not"    => '¼', "shy"    => '¡', "reg"    => '«', "macr"   => '»',
  50.    "deg"    => '░', "plusmn" => '▒', "sup2"   => '▓', "sup3"   => '│',
  51.    "acute"  => '┤', "micro"  => '╡', "para"   => '╢', "middot" => '╖',
  52.    "cedil"  => '╕', "sup1"   => '╣', "ordm"   => '║', "raquo"  => '╗',
  53.    "frac14" => '╝', "frac12" => '╜', "frac34" => '╛', "iquest" => '┐',
  54.    "Agrave" => '└', "Aacute" => '┴', "Acirc"  => '┬', "Atilde" => '├',
  55.    "Auml"   => '─', "Aring"  => '┼', "AElig"  => '╞', "Ccedil" => '╟',
  56.    "Egrave" => '╚', "Eacute" => '╔', "Ecirc"  => '╩', "Euml"   => '╦',
  57.    "Igrave" => '╠', "Iacute" => '═', "Icirc"  => '╬', "Iuml"   => '╧',
  58.    "ETH"    => '╨', "Ntilde" => '╤', "Ograve" => '╥', "Oacute" => '╙',
  59.    "Ocirc"  => '╘', "Otilde" => '╒', "Ouml"   => '╓', "times"  => '╫',
  60.    "Oslash" => '╪', "Ugrave" => '┘', "Uacute" => '┌', "Ucirc"  => '█',
  61.    "Uuml"   => '▄', "Yacute" => '▌', "THORN"  => '▐', "szlig"  => '▀',
  62.    "agrave" => 'α', "aacute" => 'ß', "acirc"  => 'Γ', "atilde" => 'π',
  63.    "auml"   => 'Σ', "aring"  => 'σ', "aelig"  => 'µ', "ccedil" => 'τ',
  64.    "egrave" => 'Φ', "eacute" => 'Θ', "ecirc"  => 'Ω', "euml"   => 'δ',
  65.    "igrave" => '∞', "iacute" => 'φ', "icirc"  => 'ε', "iuml"   => '∩',
  66.    "eth"    => '≡', "ntilde" => '±', "ograve" => '≥', "oacute" => '≤',
  67.    "ocirc"  => '⌠', "otilde" => '⌡', "ouml"   => '÷', "divide" => '≈',
  68.    "oslash" => '°', "ugrave" => '∙', "uacute" => '·', "ucirc"  => '√',
  69.    "uuml"   => 'ⁿ', "yacute" => '²', "thorn"  => '■', "yuml"   => ' ',
  70.    "apos"   => '\''
  71. );
  72.  
  73. # Maps certain UTF8 characters (2 or 3 bytes) to the corresponding
  74. # Latin1 characters.
  75. #
  76. my %unicode_latin1_table = (
  77.    "\xC2\xA1" => 'í', "\xC2\xA2" => 'ó', "\xC2\xA3" => 'ú', "\xC2\xA4" => 'ñ',
  78.    "\xC2\xA5" => 'Ñ', "\xC2\xA6" => 'ª', "\xC2\xA7" => 'º', "\xC2\xA8" => '¿',
  79.    "\xC2\xA9" => '⌐', "\xC2\xAA" => '¬', "\xC2\xAB" => '½', "\xC2\xAC" => '¼',
  80.    "\xC2\xAD" => '¡', "\xC2\xAE" => '«', "\xC2\xAF" => '»', "\xC2\xB0" => '░',
  81.    "\xC2\xB1" => '▒', "\xC2\xB2" => '▓', "\xC2\xB3" => '│', "\xC2\xB4" => '┤',
  82.    "\xC2\xB5" => '╡', "\xC2\xB6" => '╢', "\xC2\xB7" => '╖', "\xC2\xB8" => '╕',
  83.    "\xC2\xB9" => '╣', "\xC2\xBA" => '║', "\xC2\xBB" => '╗', "\xC2\xBC" => '╝',
  84.    "\xC2\xBD" => '╜', "\xC2\xBE" => '╛', "\xC2\xBF" => '┐', "\xC3\x80" => '└',
  85.    "\xC3\x81" => '┴', "\xC3\x82" => '┬', "\xC3\x83" => '├', "\xC3\x84" => '─',
  86.    "\xC3\x85" => '┼', "\xC3\x86" => '╞', "\xC3\x87" => '╟', "\xC3\x88" => '╚',
  87.    "\xC3\x89" => '╔', "\xC3\x8A" => '╩', "\xC3\x8B" => '╦', "\xC3\x8C" => '╠',
  88.    "\xC3\x8D" => '═', "\xC3\x8E" => '╬', "\xC3\x8F" => '╧', "\xC3\x90" => '╨',
  89.    "\xC3\x91" => '╤', "\xC3\x92" => '╥', "\xC3\x93" => '╙', "\xC3\x94" => '╘',
  90.    "\xC3\x95" => '╒', "\xC3\x96" => '╓', "\xC3\x97" => '╫', "\xC3\x98" => '╪',
  91.    "\xC3\x99" => '┘', "\xC3\x9A" => '┌', "\xC3\x9B" => '█', "\xC3\x9C" => '▄',
  92.    "\xC3\x9D" => '▌', "\xC3\x9E" => '▐', "\xC3\x9F" => '▀', "\xC3\xA0" => 'α',
  93.    "\xC3\xA1" => 'ß', "\xC3\xA2" => 'Γ', "\xC3\xA3" => 'π', "\xC3\xA4" => 'Σ',
  94.    "\xC3\xA5" => 'σ', "\xC3\xA6" => 'µ', "\xC3\xA7" => 'τ', "\xC3\xA8" => 'Φ',
  95.    "\xC3\xA9" => 'Θ', "\xC3\xAA" => 'Ω', "\xC3\xAB" => 'δ', "\xC3\xAC" => '∞',
  96.    "\xC3\xAD" => 'φ', "\xC3\xAE" => 'ε', "\xC3\xAF" => '∩', "\xC3\xB0" => '≡',
  97.    "\xC3\xB1" => '±', "\xC3\xB2" => '≥', "\xC3\xB3" => '≤', "\xC3\xB4" => '⌠',
  98.    "\xC3\xB5" => '⌡', "\xC3\xB6" => '÷', "\xC3\xB7" => '≈', "\xC3\xB8" => '°',
  99.    "\xC3\xB9" => '∙', "\xC3\xBA" => '·', "\xC3\xBB" => '√', "\xC3\xBC" => 'ⁿ',
  100.    "\xC3\xBD" => '²', "\xC3\xBE" => '■', "\xC3\xBF" => ' ',
  101.  
  102.    "\xE2\x80\x93" => '--',  "\xE2\x80\x94" => '--',
  103.    "\xE2\x80\x98" => '`',   "\xE2\x80\x99" => '\'',
  104.    "\xE2\x80\x9C" => "``",  "\xE2\x80\x9D" => "''",
  105.    "\xE2\x80\xA6" => '...',
  106. );
  107.  
  108.  
  109. # Convert any HTML entities to Latin1 characters.
  110. #
  111. sub de_entify($) {
  112.   my ($text) = @_;
  113.   $text =~ s/(&(\#)?([[:alpha:]\d]+);?)/
  114.     {
  115.      my $c;
  116.      if ($2) {
  117.        $c = chr($3);  # the &#number is always decimal, right?
  118.      } else {
  119.        $c = $entity_table{$3};
  120.      }
  121. #    print STDERR "$progname: warning: unknown HTML character entity \"$1\"\n"
  122. #     unless $c;
  123.      ($c ? $c : "[$3]");
  124.     }
  125.    /gexi;
  126.   return $text;
  127. }
  128.  
  129.  
  130. # Convert any Unicode characters to Latin1 if possible.
  131. # Unconvertable bytes are left alone.
  132. #
  133. sub de_unicoddle($) {
  134.   my ($text) = @_;
  135.   foreach my $key (keys (%unicode_latin1_table)) {
  136.     my $val = $unicode_latin1_table{$key};
  137.     $text =~ s/$key/$val/gs;
  138.   }
  139.   return $text;
  140. }
  141.  
  142.  
  143. # Reads the prefs we use from ~/.xscreensaver
  144. #
  145. sub get_prefs() {
  146.  
  147.   my $got_any_p = 0;
  148.   local *IN;
  149.  
  150.   if (open (IN, "<$config_file")) {
  151.     print STDERR "$progname: reading $config_file\n" if ($verbose > 1);
  152.     my $body = '';
  153.     while (<IN>) { $body .= $_; }
  154.     close IN;
  155.     $got_any_p = get_prefs_1 ($body);
  156.  
  157.   } elsif ($verbose > 1) {
  158.     print STDERR "$progname: $config_file: $!\n";
  159.   }
  160.  
  161.   if (! $got_any_p) {
  162.     # We weren't able to read settings from the .xscreensaver file.
  163.     # Fall back to any settings in the X resource database
  164.     # (/usr/X11R6/lib/X11/app-defaults/XScreenSaver)
  165.     #
  166.     print STDERR "$progname: reading X resources\n" if ($verbose > 1);
  167.     my $body = `appres XScreenSaver xscreensaver -1`;
  168.     $got_any_p = get_prefs_1 ($body);
  169.   }
  170.  
  171.   if ($verbose > 1) {
  172.     printf STDERR "$progname: mode:    $text_mode\n";
  173.     printf STDERR "$progname: literal: $text_literal\n";
  174.     printf STDERR "$progname: file:    $text_file\n";
  175.     printf STDERR "$progname: program: $text_program\n";
  176.     printf STDERR "$progname: url:     $text_url\n";
  177.   }
  178.  
  179.   $text_mode =~ tr/A-Z/a-z/;
  180.   $text_literal =~ s@\\n@\n@gs;
  181. }
  182.  
  183.  
  184. sub get_prefs_1($) {
  185.   my ($body) = @_;
  186.  
  187.   my $got_any_p = 0;
  188.   $body =~ s@\\\n@@gs;
  189.  
  190.   if ($body =~ m/^[.*]*textMode:[ \t]*([^\s]+)\s*$/im) {
  191.     $text_mode = $1;
  192.     $got_any_p = 1;
  193.   }
  194.   if ($body =~ m/^[.*]*textLiteral:[ \t]*(.*?)[ \t]*$/im) {
  195.     $text_literal = $1;
  196.   }
  197.   if ($body =~ m/^[.*]*textFile:[ \t]*(.*?)[ \t]*$/im) {
  198.     $text_file = $1;
  199.   }
  200.   if ($body =~ m/^[.*]*textProgram:[ \t]*(.*?)[ \t]*$/im) {
  201.     $text_program = $1;
  202.   }
  203.   if ($body =~ m/^[.*]*textURL:[ \t]*(.*?)[ \t]*$/im) {
  204.     $text_url = $1;
  205.   }
  206.  
  207.   return $got_any_p;
  208. }
  209.  
  210.  
  211. # like system() but checks errors.
  212. #
  213. sub safe_system(@) {
  214.   my (@cmd) = @_;
  215.  
  216.   print STDERR "$progname: executing " . join(' ', @cmd) . "\n"
  217.     if ($verbose > 3);
  218.  
  219.   system @cmd;
  220.   my $exit_value  = $? >> 8;
  221.   my $signal_num  = $? & 127;
  222.   my $dumped_core = $? & 128;
  223.   error ("$cmd[0]: core dumped!") if ($dumped_core);
  224.   error ("$cmd[0]: signal $signal_num!") if ($signal_num);
  225.   error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
  226. }
  227.  
  228.  
  229. sub which($) {
  230.   my ($cmd) = @_;
  231.  
  232.   if ($cmd =~ m@^\./|^/@) {
  233.     error ("cannot execute $cmd") unless (-x $cmd);
  234.     return $cmd;
  235.   }
  236.  
  237.  foreach my $dir (split (/:/, $ENV{PATH})) {
  238.     my $cmd2 = "$dir/$cmd";
  239.     print STDERR "$progname:   checking $cmd2\n" if ($verbose > 3);
  240.     return $cmd2 if (-x "$cmd2");
  241.   }
  242.   error ("$cmd not found on \$PATH");
  243. }
  244.  
  245.  
  246. sub output() {
  247.  
  248.   # Do some basic sanity checking (null text, null file names, etc.)
  249.   #
  250.   if (($text_mode eq 'literal' && $text_literal =~ m/^\s*$/i) ||
  251.       ($text_mode eq 'file'    && $text_file    =~ m/^\s*$/i) ||
  252.       ($text_mode eq 'program' && $text_program =~ m/^\s*$/i) ||
  253.       ($text_mode eq 'url'     && $text_url     =~ m/^\s*$/i)) {
  254.     print STDERR "$progname: falling back to 'date'\n" if ($verbose);
  255.     $text_mode = 'date';
  256.   }
  257.  
  258.   if ($text_mode eq 'literal') {
  259.     $text_literal = strftime ($text_literal, localtime);
  260.     print STDOUT $text_literal;
  261.     print STDOUT "\n" unless ($text_literal =~ m/\n$/s);
  262.  
  263.   } elsif ($text_mode eq 'file') {
  264.  
  265.     local *IN;
  266.     if (open (IN, "<$text_file")) {
  267.       print STDERR "$progname: reading $text_file\n" if ($verbose);
  268.  
  269.       if ($wrap_columns && $wrap_columns > 0) {
  270.         # read it, then reformat it.
  271.         my $body = '';
  272.         while (<IN>) { $body .= $_; }
  273.         reformat_text ($body);
  274.       } else {
  275.         # stream it
  276.         while (<IN>) { print $_; }
  277.       }
  278.       close IN;
  279.     } else {
  280.       error ("$text_file: $!");
  281.     }
  282.  
  283.   } elsif ($text_mode eq 'program') {
  284.  
  285.     my ($prog, $args) = ($text_program =~ m/^([^\s]+)(.*)$/);
  286.     $text_program = which ($prog) . $args;
  287.     print STDERR "$progname: running $text_program\n" if ($verbose);
  288.  
  289.     if ($wrap_columns && $wrap_columns > 0) {
  290.       # read it, then reformat it.
  291.       my $body = `( $text_program ) 2>&1`;
  292.       reformat_text ($body);
  293.     } else {
  294.       # stream it
  295.       safe_system ("$text_program");
  296.     }
  297.  
  298.   } elsif ($text_mode eq 'url') {
  299.  
  300.     get_url_text ($text_url);
  301.  
  302.   } else { # $text_mode eq 'date'
  303.  
  304.     safe_system ("uname", "-n");
  305.     if (-f "/etc/redhat-release") { system ("cat", "/etc/redhat-release"); }
  306.     safe_system ("uname", "-sr");
  307.     print "\n";
  308.     safe_system ("date", "+%c");
  309.     print "\n";
  310.     my $ut = `uptime`;
  311.     $ut =~ s/^[ \d:]*(am|pm)?//i;
  312.     $ut =~ s/,\s*(load)/\n$1/;
  313.     print "$ut\n";
  314.   }
  315.  
  316. }
  317.  
  318.  
  319. # Loads the given URL, returns: $http, $head, $body.
  320. #
  321. sub get_url_1($;$) {
  322.   my ($url, $referer) = @_;
  323.   
  324.   if (! ($url =~ m@^http://@i)) {
  325.     error ("not an HTTP URL: $url");
  326.   }
  327.  
  328.   my ($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
  329.   $path = "" unless $path;
  330.  
  331.   my ($them,$port) = split(/:/, $serverstring);
  332.   $port = 80 unless $port;
  333.  
  334.   my $them2 = $them;
  335.   my $port2 = $port;
  336.   if ($http_proxy) {
  337.     $serverstring = $http_proxy if $http_proxy;
  338.     $serverstring =~ s@^[a-z]+://@@;
  339.     ($them2,$port2) = split(/:/, $serverstring);
  340.     $port2 = 80 unless $port2;
  341.   }
  342.  
  343.   my ($remote, $iaddr, $paddr, $proto, $line);
  344.   $remote = $them2;
  345.   if ($port2 =~ /\D/) { $port2 = getservbyname($port2, 'tcp') }
  346.   if (!$port2) {
  347.     error ("unrecognised port in $url");
  348.   }
  349.  
  350.   $iaddr = inet_aton($remote);
  351.   return ("error", "host not found", "$remote") unless ($iaddr);
  352.  
  353.   $paddr   = sockaddr_in($port2, $iaddr);
  354.  
  355.  
  356.   my $head = "";
  357.   my $body = "";
  358.  
  359.   $proto   = getprotobyname('tcp');
  360.   if (!socket(S, PF_INET, SOCK_STREAM, $proto)) {
  361.     error ("socket: $!");
  362.   }
  363.   if (!connect(S, $paddr)) {
  364.     return ("error", "connect($serverstring)", "$!");
  365.   }
  366.  
  367.   select(S); $| = 1; select(STDOUT);
  368.  
  369.   my $user_agent = "$progname/$version";
  370.  
  371.   my $hdrs = ("GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" .
  372.               "Host: $them\r\n" .
  373.               "User-Agent: $user_agent\r\n");
  374.   if ($referer) {
  375.     $hdrs .= "Referer: $referer\r\n";
  376.   }
  377.   $hdrs .= "\r\n";
  378.  
  379.   if ($verbose > 3) {
  380.     foreach (split('\r?\n', $hdrs)) {
  381.       print STDERR "  ==> $_\n";
  382.     }
  383.   }
  384.   print S $hdrs;
  385.   my $http = <S> || "";
  386.  
  387.   $_  = $http;
  388.   s/[\r\n]+$//s;
  389.   print STDERR "  <== $_\n" if ($verbose > 3);
  390.  
  391.   while (<S>) {
  392.     $head .= $_;
  393.     s/[\r\n]+$//s;
  394.     last if m@^$@;
  395.     print STDERR "  <== $_\n" if ($verbose > 3);
  396.   }
  397.  
  398.   print STDERR "  <== \n" if ($verbose > 4);
  399.   my $lines = 0;
  400.   while (<S>) {
  401.     s/\r\n/\n/gs;
  402.     print STDERR "  <== $_" if ($verbose > 4);
  403.     $body .= $_;
  404.     $lines++;
  405.   }
  406.  
  407.   print STDERR "  <== [ body ]: $lines lines, " . length($body) . " bytes\n"
  408.     if ($verbose == 4);
  409.  
  410.   close S;
  411.  
  412.   if (!$http) {
  413.     error ("null response: $url");
  414.   }
  415.  
  416.   return ( $http, $head, $body );
  417. }
  418.  
  419.  
  420. # Loads the given URL, processes redirects, returns (content-type, body).
  421. #
  422. sub get_url($;$) {
  423.   my ($url, $referer) = @_;
  424.  
  425.   print STDERR "$progname: loading $url\n" if ($verbose > 2);
  426.  
  427.   my $orig_url = $url;
  428.   my $loop_count = 0;
  429.   my $max_loop_count = 10;
  430.  
  431.   do {
  432.     my ( $http, $head, $body ) = get_url_1 ($url, $referer);
  433.  
  434.     if ( $http eq "error" ) {
  435.       return ("error", "$head: $body");
  436.     }
  437.  
  438.     $http =~ s/[\r\n]+$//s;
  439.  
  440.     if ( $http =~ m@^HTTP/[0-9.]+ 30[123]@ ) {
  441.       $_ = $head;
  442.  
  443.       my ( $location ) = m@^location:[ \t]*(.*)$@im;
  444.       if ( $location ) {
  445.         $location =~ s/[\r\n]$//;
  446.  
  447.         print STDERR "$progname: redirect from $url to $location\n"
  448.           if ($verbose > 3);
  449.  
  450.         $referer = $url;
  451.         $url = $location;
  452.  
  453.         if ($url =~ m@^/@) {
  454.           $referer =~ m@^(http://[^/]+)@i;
  455.           $url = $1 . $url;
  456.         } elsif (! ($url =~ m@^[a-z]+:@i)) {
  457.           $_ = $referer;
  458.           s@[^/]+$@@g if m@^http://[^/]+/@i;
  459.           $_ .= "/" if m@^http://[^/]+$@i;
  460.           $url = $_ . $url;
  461.         }
  462.  
  463.       } else {
  464.         error ("no Location with \"$http\"");
  465.       }
  466.  
  467.       if ($loop_count++ > $max_loop_count) {
  468.         error ("too many redirects ($max_loop_count) from $orig_url");
  469.       }
  470.  
  471.     } elsif ( $http =~ m@^HTTP/[0-9.]+ ([4-9][0-9][0-9].*)$@ ) {
  472.       error ("failed: $1 ($url)");
  473.  
  474.     } else {
  475.       my $ct = 'text/plain';
  476.       $ct = $1 if ($head =~ m/^content-type:\s*([^\s]+)/mi);
  477.       return ($ct, $body);
  478.     }
  479.   } while (1);
  480. }
  481.  
  482.  
  483. # Make an educated guess as to what's in this document.
  484. # We don't necessarily take the Content-Type header at face value.
  485. # Returns 'html', 'rss', or 'text';
  486. #
  487. sub guess_content_type($$) {
  488.   my ($ct, $body) = @_;
  489.  
  490.   $body =~ s/^(.{512}).*/$1/s;  # only look in first half K of file
  491.  
  492.   if ($ct =~ m@^text/.*html@i)          { return 'html'; }
  493.   if ($ct =~ m@\b(atom|rss|xml)\b@i)    { return 'rss';  }
  494.  
  495.   if ($body =~ m@^\s*<\?xml@is)         { return 'rss';  }
  496.   if ($body =~ m@^\s*<!DOCTYPE RSS@is)  { return 'rss';  }
  497.   if ($body =~ m@^\s*<!DOCTYPE HTML@is) { return 'html'; }
  498.  
  499.   if ($body =~ m@<(BASE|HTML|HEAD|BODY|SCRIPT|STYLE|TABLE|A\s+HREF)\b@i) {
  500.     return 'html';
  501.   }
  502.  
  503.   if ($body =~ m@<(RSS|CHANNEL|GENERATOR|DESCRIPTION|CONTENT|FEED|ENTRY)\b@i) {
  504.     return 'rss';
  505.   }
  506.  
  507.   return 'text';
  508. }
  509.  
  510. sub reformat_html($$) {
  511.   my ($body, $rss_p) = @_;
  512.   $_ = $body;
  513.  
  514.   if (! $rss_p) {
  515.     # In HTML, unfold lines (this breaks PRE.  Sue me.)
  516.     # In RSS, assume \n means literal line break.
  517.     s@[\r\n]@ @gsi;
  518.   }
  519.  
  520.   s@<!--.*?-->@@gsi;                 # lose comments
  521.   s@<(STYLE|SCRIPT)\b[^<>]*>.*?</\1\s*>@@gsi;    # lose css and js
  522.  
  523.   s@</?(BR|TR|TD|LI|DIV)\b[^<>]*>@\n@gsi; # line break at BR, TD, DIV, etc
  524.   s@</?(P|UL|OL|BLOCKQUOTE)\b[^<>]*>@\n\n@gsi; # two line breaks
  525.  
  526.   s@<lj\s+user=\"?([^<>\"]+)\"?[^<>]*>?@$1@gsi;  # handle <LJ USER=>
  527.   s@</?[BI]>@*@gsi;                         # bold, italic => asterisks
  528.  
  529.  
  530.   s@<[^<>]*>?@@gs;                # lose all other HTML tags
  531.   $_ = de_entify ($_);            # convert HTML entities
  532.  
  533.   # elide any remaining non-Latin1 binary data...
  534.   s/([\177-\377]+(\s*[\177-\377]+)[^a-z\d]*)/½...╗ /g;
  535.   #s/([\177-\377]+(\s*[\177-\377]+)[^a-z\d]*)/½$1╗ /g;
  536.  
  537.   $_ .= "\n";
  538.  
  539.   s/[ \t]+$//gm;                  # lose whitespace at end of line
  540.   s@\n\n\n+@\n\n@gs;              # compress blank lines
  541.  
  542.   if (!defined($wrap_columns) || $wrap_columns > 0) {
  543.     $Text::Wrap::columns = ($wrap_columns || 72);
  544.     $_ = wrap ("", "  ", $_);     # wrap the lines as a paragraph
  545.     s/[ \t]+$//gm;                # lose whitespace at end of line again
  546.   }
  547.  
  548.   print STDOUT $_;
  549. }
  550.  
  551.  
  552. sub reformat_rss($) {
  553.   my ($body) = @_;
  554.  
  555.   $body =~ s/(<(ITEM|ENTRY)\b)/\001\001$1/gsi;
  556.   my @items = split (/\001\001/, $body);
  557.  
  558.   print STDERR "$progname: converting RSS ($#items items)...\n"
  559.     if ($verbose > 2);
  560.  
  561.   shift @items;
  562.  
  563.   # Let's skip forward in the stream by a random amount, so that if
  564.   # two copies of ljlatest are running at the same time (e.g., on a
  565.   # multi-headed machine), they get different text.  (Put the items
  566.   # that we take off the front back on the back.)
  567.   #
  568.   if ($#items > 7) {
  569.     my $n = int (rand ($#items - 5));
  570.     print STDERR "$progname: rotating by $n items...\n" if ($verbose > 2);
  571.     while ($n-- > 0) {
  572.       push @items, (shift @items);
  573.     }
  574.   }
  575.  
  576.   my $i = -1;
  577.   foreach (@items) {
  578.     $i++;
  579.  
  580.     my ($title, $body1, $body2, $body3);
  581.     
  582.     $title = $3 if (m@<((TITLE)       [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  583.     $body1 = $3 if (m@<((DESCRIPTION) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  584.     $body2 = $3 if (m@<((CONTENT)     [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  585.     $body3 = $3 if (m@<((SUMMARY)     [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
  586.  
  587.     # If there are both <description> and <content> or <content:encoded>,
  588.     # use whichever one contains more text.
  589.     #
  590.     if ($body3 && length($body3) >= length($body2 || '')) {
  591.       $body2 = $body3;
  592.     }
  593.     if ($body2 && length($body2) >= length($body1 || '')) {
  594.       $body1 = $body2;
  595.     }
  596.  
  597.     if (! $body1) {
  598.       if ($title) {
  599.         print STDERR "$progname: no body in item $i (\"$title\")\n"
  600.           if ($verbose > 2);
  601.       } else {
  602.         print STDERR "$progname: no body or title in item $i\n"
  603.           if ($verbose > 2);
  604.         next;
  605.       }
  606.     }
  607.  
  608.     $title = rss_field_to_html ($title || '');
  609.     $body1 = rss_field_to_html ($body1 || '');
  610.  
  611.     reformat_html ("$title<P>$body1", 1);
  612.     print "\n";
  613.   }
  614. }
  615.  
  616.  
  617. sub rss_field_to_html($) {
  618.   my ($body) = @_;
  619.  
  620.   # Assume that if <![CDATA[...]]> is present, everything inside that.
  621.   #
  622.   if ($body =~ m/^\s*<!\[CDATA\[(.*?)\]\s*\]/is) {
  623.     $body = $1;
  624.   } else {
  625.     $body = de_entify ($body);      # convert entities to get HTML from XML
  626.   }
  627.  
  628.   $body = de_unicoddle ($body);     # convert UTF8 to Latin1
  629.   return $body;
  630. }
  631.  
  632.  
  633. sub reformat_text($) {
  634.   my ($body) = @_;
  635.  
  636.   # only re-wrap if --cols was specified.  Otherwise, dump it as is.
  637.   #
  638.   if ($wrap_columns && $wrap_columns > 0) {
  639.     print STDERR "$progname: wrapping at $wrap_columns...\n" if ($verbose > 2);
  640.     $Text::Wrap::columns = $wrap_columns;
  641.     $body = wrap ("", "", $body);
  642.     $body =~ s/[ \t]+$//gm;
  643.   }
  644.  
  645.   print STDOUT $body;
  646. }
  647.  
  648.  
  649. sub get_url_text($) {
  650.   my ($url) = @_;
  651.  
  652.   # historical suckage: the environment variable name is lower case.
  653.   $http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY};
  654.  
  655.   if ($http_proxy && $http_proxy =~ m@^http://([^/]*)/?$@ ) {
  656.     # historical suckage: allow "http://host:port" as well as "host:port".
  657.     $http_proxy = $1;
  658.   }
  659.  
  660.   my ($ct, $body) = get_url ($url);
  661.   if ($ct eq "error") {
  662.     $text_mode = 'file';
  663.     output ();
  664.     exit;
  665.   }
  666.  
  667.   $ct = guess_content_type ($ct, $body);
  668.   if ($ct eq 'html') {
  669.     print STDERR "$progname: converting HTML...\n" if ($verbose > 2);
  670.     reformat_html ($body, 0);
  671.   } elsif ($ct eq 'rss')  {
  672.     reformat_rss ($body);
  673.   } else {
  674.     print STDERR "$progname: plain text...\n" if ($verbose > 2);
  675.     reformat_text ($body);
  676.   }
  677. }
  678.  
  679.  
  680.  
  681. sub error($) {
  682.   my ($err) = @_;
  683.   print STDERR "$progname: $err\n";
  684.   exit 1;
  685. }
  686.  
  687. sub usage() {
  688.   print STDERR "usage: $progname [ --options ... ]\n" .
  689.    ("\n" .
  690.     "       Prints out some text for use by various screensavers,\n" .
  691.     "       according to the options in the ~/.xscreensaver file.\n" .
  692.     "       This may dump the contents of a file, run a program,\n" .
  693.     "       or load a URL.\n".
  694.     "\n" .
  695.     "   Options:\n" .
  696.     "\n" .
  697.     "       --date           Print the host name and current time.\n" .
  698.     "\n" .
  699.     "       --text STRING    Print out the given text.  It may contain %\n" .
  700.     "                        escape sequences as per strftime(2).\n" .
  701.     "\n" .
  702.     "       --file PATH      Print the contents of the given file.\n" .
  703.     "                        If --cols is specified, re-wrap the lines;\n" .
  704.     "                        otherwise, print them as-is.\n" .
  705.     "\n" .
  706.     "       --program CMD    Run the given program and print its output.\n" .
  707.     "                        If --cols is specified, re-wrap the output.\n" .
  708.     "\n" .
  709.     "       --url HTTP-URL   Download and print the contents of the HTTP\n" .
  710.     "                        document.  If it contains HTML, RSS, or Atom,\n" .
  711.     "                        it will be converted to plain-text.\n" .
  712.     "\n" .
  713.     "       --cols N         Wrap lines at this column.  Default 72.\n" .
  714.     "\n");
  715.   exit 1;
  716. }
  717.  
  718. sub main() {
  719.  
  720.   my $load_p = 1;
  721.  
  722.   while ($#ARGV >= 0) {
  723.     $_ = shift @ARGV;
  724.     if ($_ eq "--verbose") { $verbose++; }
  725.     elsif (m/^-v+$/) { $verbose += length($_)-1; }
  726.     elsif (m/^--?date$/)    { $text_mode = 'date';
  727.                               $load_p = 0; }
  728.     elsif (m/^--?text$/)    { $text_mode = 'literal';
  729.                               $text_literal = shift @ARGV;
  730.                               $load_p = 0; }
  731.     elsif (m/^--?file$/)    { $text_mode = 'file';
  732.                               $text_file = shift @ARGV;
  733.                               $load_p = 0; }
  734.     elsif (m/^--?program$/) { $text_mode = 'program';
  735.                               $text_program = shift @ARGV;
  736.                               $load_p = 0; }
  737.     elsif (m/^--?url$/)     { $text_mode = 'url';
  738.                               $text_url = shift @ARGV;
  739.                               $load_p = 0; }
  740.     elsif (m/^--?col(umn)?s?$/) { $wrap_columns = 0 + shift @ARGV; }
  741.     elsif (m/^-./) { usage; }
  742.     else { usage; }
  743.   }
  744.  
  745.   get_prefs() if ($load_p);
  746.   output();
  747. }
  748.  
  749. main();
  750. exit 0;
  751.