bin/fvwm-menu-headlines.in

   1 #!@PERL@
   2
   3 # Copyright (c) 1999-2009 Mikhael Goikhman
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18
  19 # Filter this script to pod2man to get a man page:
  20 #   pod2man -c "Fvwm Utilities" fvwm-menu-headlines | nroff -man | less -e
  21
  22 require 5.002;
  23 use strict;
  24 use vars qw($site_info @smonths @lmonths %smonth_hash %lmonth_hash);
  25 use vars qw($entity_map $error_menu_content);
  26 use Getopt::Long;
  27 use Socket;
  28 use POSIX qw(strftime);
  29 use Time::Local;
  30
  31 my $version = "@VERSION@";
  32
  33 local $site_info = {
  34         'freshmeat' => {
  35                 'name' => "FreshMeat",
  36                 'host' => "freshmeat.net",
  37                 'path' => "/backend/recentnews.txt",
  38                 'func' => \&process_freshmeat,
  39                 'flds' => 'headline, date, url',
  40         },
  41         'slashdot' => {
  42                 'name' => "Slashdot",
  43                 'host' => "slashdot.org",
  44                 'path' => "/slashdot.xml",
  45                 'func' => \&process_slashdot,
  46                 'flds' => 'title, url, time, author, department, topic, comments, section, image',
  47         },
  48         'linuxtoday' => {
  49                 'name' => "LinuxToday",
  50                 'host' => "linuxtoday.com",
  51                 'path' => "/lthead.txt",
  52                 'func' => \&process_linuxtoday,
  53                 'flds' => 'headline, url, date',
  54         },
  55         'old-segfault' => {
  56                 'name' => "Old-Segfault (empty now)",
  57                 'host' => "segfault.org",
  58                 'path' => "/stories.txt",
  59                 'func' => \&process_segfault,
  60                 'flds' => 'headline, url, date, author_name, author_email, type',
  61         },
  62         'old-appwatch' => {
  63                 'name' => "Old-AppWatch (closed by ZDNet)",
  64                 'host' => "www.appwatch.com",
  65                 'path' => "/appwatch.rdf",
  66                 'func' => \&process_poor_rdf,
  67                 'flds' => 'title, link, description',
  68         },
  69         'old-linuxapps' => {
  70                 'name' => "Old-LinuxApps (moved/closed)",
  71                 'host' => "www.linuxapps.com-closed",
  72                 'path' => "/backend/linux_basic.txt",
  73                 'func' => undef,
  74                 'flds' => 'headline, date, url',
  75         },
  76         'old-justlinux' => {
  77                 'name' => "Old-JustLinux (no headlines?)",
  78                 'host' => "www.justlinux.com",
  79                 'path' => "/backend/discussion.rdf",
  80                 'func' => \&process_poor_rdf,
  81                 'flds' => 'title, link',
  82         },
  83         'daemonnews' => {
  84                 'name' => "DaemonNews",
  85                 'host' => "daily.daemonnews.org",
  86                 'path' => "/ddn.rdf.php3",
  87                 'func' => \&process_poor_rdf,
  88                 'flds' => 'title, link',
  89         },
  90         # this is now called FootNotes or GNOME Desktop News, was news.gnome.org
  91         'gnome-news' => {
  92                 'name' => "GNOME-News",
  93                 'host' => "www.gnomedesktop.org",
  94                 'path' => "/backend.php",
  95                 'func' => \&process_poor_rdf,
  96                 'flds' => 'title, link',
  97         },
  98         'kde-news' => {
  99                 'name' => "KDE-News",
 100                 'host' => "news.kde.org",
 101                 'path' => "/rdf",
 102                 'func' => \&process_kde_news,
 103                 'flds' => 'title, link',
 104         },
 105         'old-freekde' => {
 106                 'name' => "Old-FreeKDE (taken off?)",
 107                 'host' => "freekde.org",
 108                 'path' => "/freekdeorg.rdf",
 109                 'func' => \&process_freekde,
 110                 'flds' => 'title, link',
 111         },
 112         'rootprompt' => {
 113                 'name' => "RootPrompt",
 114                 'host' => "rootprompt.org",
 115                 'path' => "/rss/",
 116                 'func' => \&process_rootprompt,
 117                 'flds' => 'title, link, description',
 118         },
 119         'newsforge' => {
 120                 'name' => "NewsForge",
 121                 'host' => "www.newsforge.com",
 122                 'path' => "/newsforge.xml",
 123                 'func' => \&process_slashdot,
 124                 'flds' => 'title, url, time, author, department, topic, comments, section, image',
 125         },
 126         'kuro5hin' => {
 127                 'name' => "Kuro5hin",
 128                 'host' => "www.kuro5hin.org",
 129                 'path' => "/backend.rdf",
 130                 'func' =>  \&process_kuro5hin,
 131                 'flds' => 'title, link, description',
 132         },
 133         'bbspot' => {
 134                 'name' => "BBSpot",
 135                 'host' => "bbspot.com",
 136                 'path' => "/bbspot.rdf",
 137                 'func' => \&process_poor_rdf,
 138                 'flds' => 'title, link',
 139         },
 140         'linuxfr' => {
 141                 'name' => "LinuxFr",
 142                 'host' => "linuxfr.org",
 143 #               'path' => "/short.php3",
 144                 'path' => "/backend.rss",
 145                 'func' => \&process_linuxfr,
 146 #               'flds' => 'headline, url, author_name, author_email, type',
 147                 'flds' => 'title, link',
 148         },
 149         'thinkgeek' => {
 150                 'name' => "ThinkGeek",
 151                 'host' => "www.thinkgeek.com",
 152                 'path' => "/thinkgeek.rdf",
 153                 'func' => \&process_poor_rdf,
 154                 'flds' => 'title, link',
 155         },
 156         'cnn' => {
 157                 'name' => "CNN",
 158                 'host' => "www.cnn.com",
 159                 'path' => "/desktop/content.html",
 160                 'func' => \&process_cnn,
 161                 'flds' => 'headline, url',
 162         },
 163         # to be removed
 164         'bbc-world' => {
 165                 'name' => "BBC-World (obsolete)",
 166                 'host' => "news.bbc.co.uk",
 167                 'path' => "/low/english/world/default.stm",
 168                 'func' => \&process_old_bbc,
 169                 'flds' => 'headline, url, abstract',
 170         },
 171         # to be removed
 172         'bbc-scitech' => {
 173                 'name' => "BBC-SciTech (obsolete)",
 174                 'host' => "news.bbc.co.uk",
 175                 'path' => "/low/english/sci/tech/default.stm",
 176                 'func' => \&process_old_bbc,
 177                 'flds' => 'headline, url, abstract',
 178         },
 179         'bbc' => {
 180                 'name' => "BBC",
 181                 'host' => "news.bbc.co.uk", 'host0' => "tickers.bbc.co.uk",
 182                 'path' => "/tickerdata/story2.dat",
 183                 'func' => \&process_bcc,
 184                 'flds' => 'story, headline, url',
 185         },
 186 };
 187
 188 # Site specific parsers may use these constants to convert month to unix time.
 189 local @smonths = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 190 local @lmonths = qw(January February March April May June July August September October November December);
 191 local (%smonth_hash, %lmonth_hash) = ();
 192 foreach (0 .. 11) { $smonth_hash{$smonths[$_]} = $_; $lmonth_hash{$lmonths[$_]} = $_; }
 193
 194 my $TIMEFIELDS_DATE_TIME = 1;
 195 my $TIMEFIELDS_ONLY_DATE = 2;
 196 my $TIMEFIELDS_NONE = 3;
 197
 198 my $home  = $ENV{'HOME'} || '/tmp';
 199 my $fvwm_user_dir = $ENV{'FVWM_USERDIR'} || "$home/.fvwm";
 200 $fvwm_user_dir = $home unless -d $fvwm_user_dir;
 201 my $work_home = "$fvwm_user_dir/.fvwm-menu-headlines";
 202
 203 require "$work_home/extension.pl" if -r "$work_home/extension.pl";
 204
 205 my $info  = undef;
 206 my $default_site = 'freshmeat';
 207 my $site  = undef;
 208 my $name  = undef;
 209 my $title = undef;
 210 my $itemf = '%h\t%[(%Y-%m-%d %H:%M)]';
 211 my $execf = q(firefox '%u');
 212 my $commf = undef;
 213 my $icont = '';
 214 my $iconi = '';
 215 my $iconh = '';
 216 my $icone = '';
 217 my $wm_icons = 0;
 218
 219 my $proxy = undef;
 220 my $port  = 80;
 221 my $frontpage = undef;
 222
 223 my @time  = localtime();
 224 my $menu_filename = undef;
 225 my $fake_filename = undef;
 226 my $timeout = 20;
 227 my $endl = "\r\n";  # this is preferable for http sockets to "\n"
 228
 229 GetOptions(
 230         "help|h|?"  => \&show_help,
 231         "version|V" => \&show_version,
 232         "info:s"    => \$info,
 233         "site=s"    => \$site,
 234         "name=s"    => \$name,
 235         "title=s"   => \$title,
 236         "item=s"    => \$itemf,
 237         "exec=s"    => \$execf,
 238         "command=s"    => \$commf,
 239         "icon-title=s" => \$icont,
 240         "icon-item=s"  => \$iconi,
 241         "icon-home=s"  => \$iconh,
 242         "icon-error=s" => \$icone,
 243         "wm-icons"  => \$wm_icons,
 244         "proxy=s"   => \$proxy,
 245         "frontpage:s" => \$frontpage,
 246         "file:s"    => \$menu_filename,
 247         "fake:s"    => \$fake_filename,
 248         "timeout=i" => \$timeout,
 249 ) || wrong_usage();
 250 wrong_usage() if @ARGV;
 251
 252 if (defined $info) {
 253         if ($info) {
 254                 my $_info = $site_info->{lc($info)};
 255                 die "Unsupported site '$info'; try --info.\n" unless $_info;
 256                 my $host0 = $_info->{'host0'} || $_info->{'host'};
 257                 print
 258                         "Site Name:\n\t$_info->{'name'}\n",
 259                         "Home Page:\n\thttp://$_info->{'host'}/\n",
 260                         "Headlines:\n\thttp://$host0$_info->{'path'}\n",
 261                         "Headline fields:\n\t$_info->{'flds'}\n";
 262         } else {
 263                 print "All supported sites:\n\t", join(", ", &get_all_site_names()),
 264                         "\n\nSpecify a site name after --info to get a site headlines info.\n";
 265         }
 266         exit(0);
 267 }
 268
 269 $site  ||= $default_site; $site = lc($site);
 270 die "Unsupported site '$site'; try --info.\n" unless exists $site_info->{$site};
 271 #$name ||= "MenuHeadlines$site_info->{$site}->{'name'}";
 272 $name  ||= $site;
 273 $title ||= "$site_info->{$site}->{'name'} Headlines";
 274
 275 my $site_name = $site_info->{$site}->{'name'};
 276 my $site_host = $site_info->{$site}->{'host'};
 277 my $site_path = $site_info->{$site}->{'path'};
 278 my $site_func = $site_info->{$site}->{'func'};
 279
 280 $commf ||= "Exec $execf";
 281
 282 $title =~ s/\\t/\t/g;
 283 $itemf =~ s/\\t/\t/g;
 284 $commf =~ s/\\t/\t/g;
 285
 286 if ($wm_icons) {
 287         $icont ||= "";
 288         $iconi ||= "menu/information.xpm";
 289         $iconh ||= "menu/home.xpm";
 290         $icone ||= "menu/choice-no.xpm";
 291 }
 292
 293 my $icont_str = $icont ? "%$icont%" : "";
 294 my $iconi_str = $iconi ? "%$iconi%" : "";
 295 my $iconh_str = $iconh ? "%$iconh%" : "";
 296 my $icone_str = $icone ? "%$icone%" : "";
 297
 298 if (defined $proxy && $proxy =~ /^(.+):(\d+)$/) {
 299         $proxy = $1;
 300         $port = $2;
 301 }
 302
 303 # Three cases:
 304 #   1) no --file option or value '-' specified (STDOUT is used)
 305 #   2) no or empty menu file in --file specified (the default name is used)
 306 #   3) non-empty menu file specified (use it)
 307 $menu_filename = undef if defined $menu_filename && $menu_filename eq '-';
 308 if ($menu_filename) {
 309         $menu_filename =~ s:^~(/|$):$home$1:;
 310         $menu_filename =~ m:^(.+)/[^/]+$:; $work_home = $1 || ".";
 311 } elsif (defined $menu_filename) {
 312         $menu_filename = "$work_home/$site.menu";
 313 }
 314
 315 my $content = "";
 316
 317 $content .= qq(DestroyMenu $name\n);
 318 $content .= qq(AddToMenu $name "$icont_str$title" Title\n);
 319 local $error_menu_content = $content;
 320
 321 my $frontpage_entry = "";
 322 if (defined $frontpage) {
 323         my $cmd = &expand_all_width_specifiers($commf, {'u' => "http://$site_host/"});
 324         $frontpage_entry = qq(+ "$iconh_str$site_name Frontpage" $cmd\n);
 325         $error_menu_content .= qq($frontpage_entry\n+ "" Nop\n);
 326 }
 327
 328 $error_menu_content .= "+ `$icone_str<msg>` DestroyMenu $name\n";
 329
 330 if (defined $frontpage && $frontpage !~ /^b/) {
 331         $content .= qq($frontpage_entry\n+ "" Nop\n);
 332 }
 333
 334 unless (defined $fake_filename) {
 335         $site_host = $site_info->{$site}->{'host0'}
 336                 if defined $site_info->{$site}->{'host0'};
 337         my $redirect_depth = 0;
 338
 339 HTTP_CONNECTION:
 340         my $host = $proxy || $site_host;
 341         my $iaddr = inet_aton($host) || &die_net("Can't resolve host $host");
 342         my $paddr = sockaddr_in($port, $iaddr);
 343         my $proto = getprotobyname('tcp');
 344
 345         local $SIG{ALRM} = sub { die "timeout\n"; };
 346         alarm($timeout);
 347         eval {
 348                 socket(SOCK, PF_INET, SOCK_STREAM, $proto) &&
 349                 connect(SOCK, $paddr)
 350         } || &die_net("Can't connect host $host");
 351         alarm(0);
 352         select(SOCK); $| = 1; select(STDOUT);
 353
 354         # do http request
 355         my $http_headers = "$endl" .
 356                 "Host: $site_host$endl" .
 357                 "Connection: close$endl" .
 358                 "User-Agent: fvwm-menu-headlines/$version$endl" .
 359                 "Pragma: no-cache$endl" .
 360                 "$endl";
 361         if (defined $proxy) {
 362                 print SOCK "GET http://$site_host$site_path HTTP/1.1$http_headers";
 363         } else {
 364                 print SOCK "GET $site_path HTTP/1.1$http_headers";
 365         }
 366
 367         unless (read_line() =~ m{HTTP/1\.\d (\d+) \w+}) {
 368                 &die_net("Invalid HTTP response from http://$site_host$site_path", 0);
 369         }
 370         my $status = $1;
 371         if ($status =~ /^301|302$/ && ++$redirect_depth < 5) {
 372                 # redirection
 373                 while (1) {
 374                         my $line = read_line();
 375                         $line =~ s/[\n\r]+$//s;
 376                         last unless $line;
 377                         if ($line =~ m{Location: http://([^/]+)(/.*)}i) {
 378                                 $site_host = $1;
 379                                 $site_path = $2;
 380                                 goto HTTP_CONNECTION;
 381                         }
 382                 }
 383         }
 384         &die_net("Unexpected HTTP response $status from http://$site_host$site_path", 0)
 385                 unless $status eq "200";
 386
 387         # skip http response headers
 388         while (read_line() !~ /^\r?\n?$/s) {}
 389 } else {
 390         if ($fake_filename) {
 391                 $fake_filename =~ s:^~(/|$):$home$1:;
 392         } else {
 393                 $fake_filename = "$work_home/$site.in";
 394         }
 395         open(SOCK, "<$fake_filename") || &die_sys("Can't open $fake_filename");
 396 }
 397
 398 my $entries = &$site_func;
 399
 400 close(SOCK) || &die_net("Error closing socket");
 401
 402 foreach (@$entries) {
 403         my $text = &expand_all_width_specifiers($itemf, $_);
 404         my $comm = &expand_all_width_specifiers($commf, $_);
 405         $text =~ s/"/\\"/g;
 406         $content .= qq(+ "$iconi_str$text" $comm\n);
 407 }
 408
 409 if (defined $frontpage && $frontpage =~ /^b/) {
 410         $content .= qq(+ "" Nop\n$frontpage_entry);
 411 }
 412
 413 if (defined $menu_filename) {
 414         unless (-d $work_home) {
 415                 mkdir($work_home, 0775) || &die_sys("Can't create $work_home");
 416         }
 417         open(MENU_FILE, ">$menu_filename") || &die_sys("Can't open $menu_filename");
 418         print MENU_FILE $content;
 419         close(MENU_FILE) || &die_sys("Can't close $menu_filename");
 420 } else {
 421         print $content;
 422 }
 423
 424 exit();
 425
 426 # ---------------------------------------------------------------------------
 427
 428 sub read_line {
 429         local $SIG{ALRM} = sub { die "timeout\n"; };
 430         alarm($timeout);
 431         my $line = eval { <SOCK> };
 432         if ($@) {
 433                 &die_net("Timeout of $timeout seconds reached") if $@ eq "timeout\n";
 434                 &die_net($@);
 435         }
 436         alarm(0);
 437         print STDERR $line if $ENV{"DEBUG_DUMP_RESPONSE"};
 438         return $line;
 439 }
 440
 441 sub read_all_lines {
 442         local $SIG{ALRM} = sub { die "timeout\n"; };
 443         alarm($timeout * 2);
 444         my $lines = eval { join('', <SOCK>) };
 445         if ($@) {
 446                 &die_net("Timeout of $timeout seconds reached") if $@ eq "timeout\n";
 447                 &die_net($@);
 448         }
 449         alarm(0);
 450         print STDERR $lines if $ENV{"DEBUG_DUMP_RESPONSE"};
 451         return $lines;
 452 }
 453
 454 # make unix time from year (2001 or 101), mon (0..11), day, hour, min, sec
 455 sub make_time {  # ($$$$$$$)
 456         my ($h_offset, $year, $mon, $day, $hour, $min, $sec) = @_;
 457         $h_offset ||= 0;
 458         my $type = $TIMEFIELDS_DATE_TIME;
 459
 460         unless (defined $hour || defined $min) {
 461                 unless ($year || $day) {
 462                         $type = $TIMEFIELDS_NONE;
 463                         return [ 0, $type ];
 464                 } else {
 465                         $type = $TIMEFIELDS_ONLY_DATE;
 466                 }
 467         }
 468
 469         $year = 1973 unless $year && $year > 0;  # it's my year :-)
 470         $mon  = 0 unless $mon && $mon > 0 && $mon <= 11;
 471         $day  = 1 unless $day && $day > 0 && $day <= 31;
 472         $hour = 12 unless $hour && $hour >= 0 && $hour < 24;
 473         $min  = 0 unless $min && $min >= 0 && $min < 60;
 474         $sec  = 0 unless $sec && $sec >= 0 && $sec < 60;
 475
 476         return [
 477                 timegm($sec, $min, $hour, $day, $mon, $year) - $h_offset * 60 * 60,
 478                 $type
 479         ];
 480 }
 481
 482 sub set_entry_aliases_and_time ($$$$) {
 483         my $entry = shift;
 484         my $aliases = shift;
 485         my $time_func = shift;
 486         my $h_offset = shift;
 487
 488         my ($alias, $orig);
 489         while (($alias, $orig) = each %$aliases) {
 490                 $entry->{$alias} = !$orig ? "" :
 491                         ref($orig) eq 'CODE' ? &{$orig}($entry) : $entry->{$orig};
 492                 $entry->{$alias} = "" unless defined $entry->{$alias};
 493         }
 494
 495         $entry->{'_'} = make_time($h_offset, &{$time_func}($entry->{'d'}));
 496 }
 497
 498 BEGIN {
 499         $entity_map = {
 500                 'gt'    => '>',
 501                 'lt'    => '<',
 502                 'quot'  => '"',
 503                 'amp'   => '&',
 504         };
 505 }
 506
 507 sub process_xml ($$$$) {
 508         my $entry_tag = shift;
 509         my $aliases = shift;
 510         my $time_func = shift;
 511         my $h_offset = shift;
 512         my @entries = ();
 513
 514         my $doc = read_all_lines();
 515
 516         ENTRY:
 517         foreach ($doc =~ m!<$entry_tag\b[^>]*>(.*?)</$entry_tag>!sg) {
 518                 s/&amp;quot;/"/g;  # fix buggy html in some backends
 519                 # replace &#039; with single quote and &quot; with double quote
 520                 s/&(?:(\w+)|#(\d{2,})|#x([\da-fA-F]{2,4}));/
 521                         $1 ? $entity_map->{$1} || "{$1}" : chr($2 || hex($3))
 522                 /ge;
 523
 524                 my $entry = {};
 525
 526                 foreach (m!(<.*?>.*?</.*?>)!sg) {
 527                         m!<(.*?)>\s*(.*?)\s*</(.*?)>!s;
 528                         # ignore incorect fields or throw error?
 529                         next unless $1 && $2 && $3;
 530                         next if $1 ne $3;
 531                         $entry->{$1} = $2;
 532                 }
 533
 534                 set_entry_aliases_and_time($entry, $aliases, $time_func, $h_offset);
 535                 push @entries, $entry;
 536         }
 537         return \@entries;
 538 }
 539
 540 sub process_text ($$$$) {
 541         my $fields = shift;
 542         my $aliases = shift;
 543         my $time_func = shift;
 544         my $h_offset = shift;
 545         my @entries = ();
 546
 547         ENTRY:
 548         while (1) {
 549                 my $entry = {};
 550                 foreach (@$fields) {
 551                         my $line = read_line();
 552                         last ENTRY unless defined $line;
 553                         next if $_ eq '_ignore_';
 554
 555                         chomp($line);
 556                         $line =~ s/"/\\"/g;
 557 #                       $line =~ s/<.*?>//g;
 558 #                       $line =~ s/&\w{1,5}?;/ /g;
 559                         $entry->{$_} = $line;
 560                 }
 561
 562                 set_entry_aliases_and_time($entry, $aliases, $time_func, $h_offset);
 563                 push @entries, $entry;
 564         }
 565         return \@entries;
 566 }
 567
 568 sub process_slashdot () {
 569         return process_xml(
 570                 'story',
 571                 { 'h' => 'title', 'u' => 'url', 'd' => 'time' },
 572                 sub ($) {
 573                         $_[0] =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/;
 574                         ($1, ($2 || 0) - 1, $3, $4, $5, $6);
 575                 }, +0,
 576         );
 577 }
 578
 579 sub process_freshmeat () {
 580         return process_text(
 581                 [ qw( headline date url ) ],
 582                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 583                 sub ($) {
 584                         $_[0] =~ /^(?:\w+, )?(\w+) (\d+)\w* (\d+),? (\d+):(\d+)/;
 585                         ($3, $lmonth_hash{$1}, $2, $4, $5, 0);
 586                 }, -5 + (abs((localtime())[4] - 5.5) < 3),
 587         );
 588 }
 589
 590 sub process_linuxtoday () {
 591         my $line;
 592         while ($line = read_line()) {
 593                 last if $line =~ /linuxtoday.com/;          # skip the text note
 594                 last if $line =~ /&&/ and read_line() x 3;  # if it was replaced
 595         }
 596         return process_text(
 597                 [ qw( _ignore_ headline url date ) ],
 598                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 599                 sub ($) {
 600                         $_[0] =~ /(\w+) (\d+), (\d+), (\d+):(\d+):(\d+)/;
 601                         ($3, $smonth_hash{$1}, $2, $4, $5, $6);
 602                 }, +0,
 603         );
 604 }
 605
 606 sub process_segfault () {
 607         my $line;
 608         while ($line = read_line()) {
 609                 last if $line =~ /^%%/;  # skip the text note
 610         }
 611         return process_text(
 612                 [ qw( headline url date author_name author_email type _ignore_ ) ],
 613                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 614                 sub ($) {
 615                         $_[0] =~ /(\d+) (\w+) (\d+):(\d+):(\d+) (\d+)/;
 616                         ($6, $smonth_hash{$2}, $1, $3, $4, $5);
 617                 }, -8 + (abs((localtime())[4] - 5.5) < 3),
 618         );
 619 }
 620
 621 sub process_poor_rdf () {
 622         return process_xml(
 623                 'item',
 624                 { 'h' => 'title', 'u' => 'link', 'd' => undef },
 625                 sub ($) {
 626                         # this site's rdf does not supply the time, how weird...
 627                         #(gmtime())[5,4,3,2,1,0];
 628                         ()
 629                 }, +0,
 630         );
 631 }
 632
 633 sub process_linuxapps_old () {
 634         return process_text(
 635                 [ qw( headline date url ) ],
 636                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 637                 sub ($) {
 638                         $_[0] =~ /(\w+) (\d+) (\d+):(\d+):(\d+) \w+ (\d+)/;
 639                         ($6, $smonth_hash{$1}, $2, $3, $4, $5);
 640                 }, -5,
 641         );
 642 }
 643
 644 sub process_kde_news () {
 645         my $link_to_time = sub ($) { $_[0]->{'link'} =~ m|/(\d+)/?$|; $1; };
 646         return process_xml(
 647                 'item',
 648                 { 'h' => 'title', 'u' => 'link', 'd' => $link_to_time },
 649                 sub ($) {
 650                         (gmtime($_[0]))[5,4,3,2,1,0];
 651                 }, +0,
 652         );
 653 }
 654
 655 sub process_freekde () {
 656         my $link_to_date = sub ($) {
 657                 $_[0]->{'link'} =~ m|/(\d\d/\d\d/\d\d)/|; $1 ? "20$1" : '';
 658         };
 659         return process_xml(
 660                 'item',
 661                 { 'h' => 'title', 'u' => 'link', 'd' => $link_to_date },
 662                 sub ($) {
 663                         $_[0] =~ m|(\d+)/(\d+)/(\d+)|;
 664                         ($1, ($2 || 0) - 1, $3);
 665                 }, +0,
 666         );
 667 }
 668
 669 sub process_rootprompt () {
 670         my $title_stripped = sub ($) {
 671                 $_[0]->{'title'} =~ /(.*) \([^\(\)]+\)$/ ? $1 : $_[0]->{'title'};
 672         };
 673         my $title_to_date = sub ($) {
 674                 $_[0]->{'title'} =~ / \((\d+ \w{3} \d{4})\)$/; $1;
 675         };
 676         return process_xml(
 677                 'item',
 678                 { 'h' => $title_stripped, 'u' => 'link', 'd' => $title_to_date },
 679                 sub ($) {
 680                         $_[0] =~ /(\d+) (\w+) (\d+)/;
 681                         ($3, $smonth_hash{$2}, $1);
 682                 }, +0,
 683         );
 684 }
 685
 686 sub process_kuro5hin () {
 687         my $link_to_date = sub ($) {
 688                 $_[0]->{'link'} =~ m|/(\d\d\d\d/\d{1,2}/\d{1,2})/|; $1;
 689         };
 690         return process_xml(
 691                 'item',
 692                 { 'h' => 'title', 'u' => 'link', 'd' => $link_to_date },
 693                 sub ($) {
 694                         $_[0] =~ m|(\d+)/(\d+)/(\d+)|;
 695                         ($1, ($2 || 0) - 1, $3);
 696                 }, +0,
 697         );
 698 }
 699
 700 sub process_linuxfr () {
 701         my $link_to_date = sub ($) {
 702                 $_[0]->{'link'} =~ m|/(\d\d\d\d/\d\d/\d\d)/|; $1;
 703         };
 704         my $hack_for_url = sub ($) {
 705                 # hack for mozilla -remote openURL
 706                 my $u = $_[0]->{'link'};
 707                 $u =~ s|,|\%2c|g; $u;
 708         };
 709         return process_xml(
 710                 'item',
 711                 { 'h' => 'title', 'u' => $hack_for_url, 'd' => $link_to_date },
 712                 sub ($) {
 713                         $_[0] =~ m|(\d+)/(\d+)/(\d+)|;
 714                         ($1, ($2 || 0) - 1, $3);
 715                 }, +0,
 716         );
 717 }
 718
 719 sub process_linuxfr_old () {
 720         my $link_to_date = sub ($) {
 721                 $_[0]->{'url'} =~ m|/(\d\d\d\d/\d\d/\d\d)/|; $1;
 722         };
 723         my $hack_for_url = sub ($) {
 724                 # hack for mozilla -remote openURL
 725                 my $u = $_[0]->{'url'};
 726                 $u =~ s|,|\%2c|g; $u;
 727         };
 728         my $line;
 729         while ($line = read_line()) {
 730                 last if $line =~ /^%%/;  # skip the text note
 731         }
 732         return process_text(
 733                 [ qw( headline url author_name author_email type _ignore_ ) ],
 734                 { 'h' => 'headline', 'u' => $hack_for_url, 'd' => $link_to_date },
 735                 sub ($) {
 736                         $_[0] =~ m|(\d+)/(\d+)/(\d+)|;
 737                         ($1, ($2 || 0) - 1, $3);
 738                 }, +0,
 739         );
 740 }
 741
 742 sub process_cnn () {
 743         my $contents = read_all_lines();
 744         my @entries = ();
 745
 746         my $link_to_date = sub ($) {
 747                 $_[0]->{'url'} =~ m|/(\d\d\d\d).*?(/\d\d/\d\d)/|; "$1$2";
 748         };
 749
 750         $contents =~ s{<a href="(/.*?)".*?>(.*?)</a>}{
 751                 my $entry = {};
 752                 $entry->{'url'} = "http://www.cnn.com$1";
 753                 $entry->{'headline'} = $2;
 754                 set_entry_aliases_and_time(
 755                         $entry,
 756                         { 'h' => 'headline', 'u' => 'url', 'd' => $link_to_date },
 757                         sub ($) {
 758                                 $_[0] =~ m|(\d+)/(\d+)/(\d+)|
 759                                         ? ($1, ($2 || 0) - 1, $3)
 760                                         : ();
 761                         }, -5,
 762                 );
 763                 push @entries, $entry;
 764                 ""
 765         }sige;
 766
 767         return \@entries;
 768 }
 769
 770 sub process_old_bbc () {
 771         my $contents = read_all_lines();
 772         $contents =~ s!\r\n...\r\n!!sg;  # they insert this randomly!
 773         $contents =~ s!\s*<(br|/h3|h3|span[^>]*|/span|img [^>]+)>[ \t\r]*\n?!!sig;
 774         my @entries = ();
 775
 776         $contents =~ s{\s+<a href="(/[^"]+?)">\s*([^\s][^<]+?)\s*</a>\s*([^<]+?)\s*(?:\n|<br )}{
 777                 my $entry = {};
 778                 my $path = $1;
 779                 $entry->{'headline'} = $2;
 780                 $entry->{'abstract'} = $3;
 781                 $path =~ s|^(/\d+)?/low/|$1/hi/|;
 782                 $entry->{'url'} = "http://news.bbc.co.uk$path";
 783                 set_entry_aliases_and_time(
 784                         $entry,
 785                         { 'h' => 'headline', 'u' => 'url', 'd' => undef },
 786                         sub ($) {
 787                                 ();  # no time...
 788                         }, +0,
 789                 );
 790                 push @entries, $entry;
 791                 ""
 792         }sige;
 793
 794         return \@entries;
 795 }
 796
 797 sub process_bcc () {
 798         read_all_lines() =~ /STORY 1\nHEADLINE Last update at (\d+:\d+)\nURL \n(.*)$/s;
 799         my ($time, $contents) = ($1, $2);
 800         die_net("Parse error. Did BBC site change format?", "") unless defined $time;
 801         my @entries = ();
 802
 803         $contents =~ s{STORY (\d+)\nHEADLINE (.*?)\nURL (.*?)\n}{
 804                 my $entry = {};
 805                 my $date = undef;
 806                 $entry->{'story'} = $1;
 807                 my $headline = $2;
 808                 my $url = $3;
 809                 if ($headline =~ /^(.+?)  (\d+ \w+ \d+)$/) {
 810                         $headline = $1;
 811                         $date = $2 . " $time";
 812                 }
 813                 $entry->{'headline'} = $headline;
 814                 $url =~ s|^(http://.*?/).*/-/(.*)$|$1$2|;
 815                 $url = "http://news.bbc.co.uk/" if $url eq "";
 816                 $entry->{'url'} = $url;
 817                 $entry->{'date'} = $date;
 818                 set_entry_aliases_and_time(
 819                         $entry,
 820                         { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 821                         sub ($) {
 822                                 return () unless defined $_[0] &&
 823                  $_[0] =~ /^(\d+) (\w+) (\d+) (\d+):(\d+)/;
 824                  ($3, $lmonth_hash{$2}, $1, $4, $5);
 825                         }, +0,
 826                 );
 827                 push @entries, $entry;
 828                 ""
 829         }sige;
 830
 831         return \@entries;
 832 }
 833
 834 # ---------------------------------------------------------------------------
 835
 836 sub die_sys ($) {
 837         my $msg = shift;
 838         $msg = "$0: $msg: [$!]\n";
 839
 840         print STDERR $msg
 841 #               # be quiet in non interactive shells?
 842 #               if ($ENV{'SHLVL'} || 0) == 1 || defined($ENV{'PS1'})
 843                 ;
 844         exit(-1);
 845 }
 846
 847 sub die_net ($;$) {
 848         my $msg = shift;
 849         my $check_network_msg = @_ ? "" : "; check network connection";
 850
 851         #die_sys($msg);
 852         $error_menu_content =~ s/<msg>/$msg$check_network_msg/;
 853         print $error_menu_content;
 854         exit(-1);
 855 }
 856
 857 # like strftime, but gets unix time, instead of sec/min/hour/day/mon/year.
 858 sub format_time ($$) {
 859         my ($fmt, $time_pair) = @_;
 860
 861         $time_pair = [] unless ref($time_pair) eq 'ARRAY';
 862         my ($time, $type) = @$time_pair;
 863         $time ||= time();
 864         $type ||= $TIMEFIELDS_NONE;
 865
 866         if ($type == $TIMEFIELDS_NONE) {
 867                 return "";
 868         } elsif ($type == $TIMEFIELDS_ONLY_DATE) {
 869                 $fmt =~ s/[:\. -]?%[HIklMprSTX][:\. -]?//g;
 870                 $fmt =~ s/%c/%a %b %d %Z %Y/g;
 871         }
 872
 873         return strftime($fmt, localtime($time));
 874 }
 875
 876 # Substitutes all %N1*N2x in $name by properly stripped and justified $values.
 877 # $name example: %[%d %b %y %H:%M], %*-7(some text), %-32*30h, %{url}.
 878 # $values is a hash of named values to substitute.
 879 sub expand_all_width_specifiers ($$) {
 880         my ($name, $values) = @_;
 881         $name =~ s/%(-?\d+)?(\*(-?)(\d+))?(\w|{\w+}|\(.*?\)|\[.*?\])/
 882                 my $tag = substr($5, 0, 1);
 883                 my $arg = length($5) == 1 ? $5 : substr($5, 1, -1);
 884                 my $value =
 885                         $tag eq '(' ? $arg :
 886                         $tag eq '[' ? format_time($arg, $values->{'_'}) :
 887                         $values->{$arg};
 888                 $value = "(%$5 is not defined)" unless defined $value;
 889                 $value = !$2 || $4 <= 3 || $4 > length($value) ? $value : $3?
 890                         "..." . substr($value, -$4 + 3, $4 - 3):
 891                         substr($value, 0, $4 - 3) . "...";
 892                 $1 ? sprintf("%$1s", $value) : $value;
 893         /ge;
 894         return $name;
 895 }
 896
 897 sub get_all_site_names () {
 898         return sort map { $site_info->{$_}->{'name'} } keys %$site_info;
 899 }
 900
 901 sub show_help {
 902         $site  ||= $default_site;
 903         #$name ||= "MenuHeadlines$site_info->{$site}->{'name'}";
 904         $name  ||= $site;
 905         $title ||= "$site_info->{$site}->{'name'} Headlines";
 906
 907         print "A perl script which builds headlines menu for fvwm.\n";
 908         print "Supported sites: ", join(', ', get_all_site_names()), "\n\n";
 909         print "Usage: $0 [OPTIONS]\n";
 910         print "Options:\n";
 911         print "\t--help           show this help and exit\n";
 912         print "\t--version        show the version and exit\n";
 913         print "\t--info=[NAME]    information about a site\n";
 914         print "\t--site=NAME      headlines site, default is $site\n";
 915         print "\t--name=NAME      menu name,  default is '$name'\n";
 916         print "\t--title=NAME     menu title, default is '$title'\n";
 917         print "\t--item=FORMAT    menu item format, default is '$itemf'\n";
 918         print "\t--exec=FORMAT    exec command, default is {$execf}\n";
 919         print "\t--command=FORMAT fvwm command, default is no\n";
 920         print "\t--icon-title=XPM menu title icon, default is no\n";
 921         print "\t--icon-item=XPM  menu item  icon, default is no\n";
 922         print "\t--icon-home=XPM  menu home  icon, default is no\n";
 923         print "\t--icon-error=XPM menu error icon, default is no\n";
 924         print "\t--wm-icons       define icon names to use with wm-icons\n";
 925         print "\t--frontpage[=V]  show frontpage item; values: top, bottom\n";
 926         print "\t--proxy=host[:port] specify proxy host and port (80)\n";
 927         print "\t--file[=FILE]    menu file, default is $work_home/$site.menu\n";
 928         print "\t--fake[=FILE]    don't connect, read input from file\n";
 929         print "\t--timeout=SECS   timeout for a line reading from a socket\n";
 930         print "Short options are ok if not ambiguous: -h, -t.\n";
 931         exit 0;
 932 }
 933
 934 sub show_version {
 935         print "$version\n";
 936         exit 0;
 937 }
 938
 939 sub wrong_usage {
 940         print STDERR "Try '$0 --help' for more information.\n";
 941         exit -1;
 942 }
 943
 944 __END__
 945
 946 # ---------------------------------------------------------------------------
 947
 948 =head1 NAME
 949
 950 fvwm-menu-headlines - builds headlines menu definition for fvwm
 951
 952 =head1 SYNOPSIS
 953
 954 B<fvwm-menu-headlines>
 955 [ B<--help>|B<-h>|B<-?> ]
 956 [ B<--version>|B<-V> ]
 957 [ B<--info> [site] ]
 958 [ B<--site>|B<-s> site ]
 959 [ B<--name>|B<-n> name ]
 960 [ B<--title>|B<-t> title ]
 961 [ B<--item> item ]
 962 [ B<--exec>|B<-e> exec-command ]
 963 [ B<--command>|B<-e> fvwm-command ]
 964 [ B<--icon-title> icon ]
 965 [ B<--icon-item> icon ]
 966 [ B<--icon-home> icon ]
 967 [ B<--icon-error> icon ]
 968 [ B<--wm-icons> ]
 969 [ B<--frontpage> [where] ]
 970 [ B<--proxy>|B<-p> host:port ]
 971 [ B<--file> [file] ]
 972 [ B<--fake> [file] ]
 973 [ B<--timeout> seconds ]
 974
 975 =head1 DESCRIPTION
 976
 977 This configurable perl script builds an fvwm menu definition for headlines
 978 of popular news web sites: FreshMeat, Slashdot, LinuxToday,
 979 DaemonNews, GNOME-News, KDE-News, RootPrompt, LinuxFr, ThinkGeek,
 980 CNN, BBC and more.
 981
 982 It is possible to specify a customized menu item format, change a command
 983 (usually launching a browser) and add menu icons (there is a support for
 984 the wm-icons package).
 985
 986 =head1 OPTIONS
 987
 988 =over 4
 989
 990 =item B<--help>
 991
 992 show the help and exit
 993
 994 =item B<--version>
 995
 996 show the version and exit
 997
 998 =item B<--info> [site]
 999
1000 if site name is given print the site specific info,
1001 otherwise print all site names
1002
1003 =item B<--site> site
1004
1005 defile a web site, headlines of which to show, this option
1006 also can be used together with --help to get new defaults.
1007 Default site: freshmeat.
1008
1009 =item B<--name> name
1010
1011 define menu name (default is "MenuHeadlinesFreshmeat")
1012
1013 =item B<--title> title
1014
1015 define menu title (default is "Freshmeat Headlines").
1016
1017 =item B<--item> label-format
1018
1019 =item B<--exec> command-format
1020
1021 define format for menu item or command (what is shown and what is
1022 executed when the item is chosen).
1023 Default label is '%h\t%[(%Y-%m-%d %H:%M)]'.
1024 TAB can be specified as '\t', but in .fvwm2rc you should specify a double
1025 backslash or a real TAB.
1026
1027 Format specifiers for a headline format:
1028
1029   %h - headline
1030   %u - url
1031   %d - date in the native format (that site backend supplied)
1032   %[strftime-argument-string] - date/time, see strftime(3)
1033     the date/time is represented according to the local time;
1034     date and/or time fields that can't be guessed are stripped
1035     Example: %[|%d %B %Y| %H:%M %S]
1036       If site supplied only date - this becomes %[|%d %B %Y|],
1037       if site supplied no date - this becomes an empty string.
1038   %{name} - site specific named value, like %{comments}
1039   %(text) - arbitrary text, good for escaping or aligning
1040
1041 These specifiers can receive an optional integer size, positive for right
1042 adjusted string or negative for left adjusted, example: %8x; and optional
1043 *num or *-num, which means to leave only the first or last (if minus) num of
1044 chars, the num must be greater than 3, since the striped part is replaced
1045 with "...", example: %*30x. Both can be combined: %-10*-20x, this instructs to
1046 get only the 20 last characters, but if the length is less then 10 - to fill
1047 with up to 10 spaces on the right.
1048
1049 Example:
1050
1051   --exec "iceweasel -remote 'openURL(%u, new-window)' || iceweasel '%u'"
1052
1053 =item B<--command> command-format
1054
1055 like B<--exec> above, but enables to specify any fvwm command,
1056 for example, "Function FuncFvwmShowURL '%u'" not only Exec.
1057
1058 In fact, --exec="mozilla '%u'" is equivalent
1059 to --command="Exec mozilla '%u'"
1060
1061 =item B<--icon-title> icon
1062
1063 =item B<--icon-item> icon
1064
1065 =item B<--icon-home> icon
1066
1067 =item B<--icon-error> icon
1068
1069 define menu icon for title, regular item, frontpage item and error item
1070 respectively. Default is no menu icons (equivalent to an empty icon argument).
1071
1072 =item B<--wm-icons>
1073
1074 define icon names suitable for use with wm-icons package.
1075 Currently this is equivalent to: --icon-title '' --icon-item
1076 menu/information.xpm --icon-home menu/home.xpm --icon-error menu/choice-no.xpm.
1077
1078 =item B<--frontpage> [where]
1079
1080 add the site frontpage item to the menu.
1081 Optional value can be used to specify where this item will be placed in
1082 the menu - 'top' or 't', 'bottom' or 'b'.
1083
1084 =item B<--proxy> host[:port]
1085
1086 define a proxy to use.
1087 Example: --proxy proxy.inter.net:3128
1088
1089 =item B<--file> [file]
1090
1091 write the menu output to specified file. If no filename is
1092 given with this option (or empty filename), the default filename
1093 WORK_HOME/SITE.menu is used. Without this option or with '-'
1094 filename, the menu output is written to standard output.
1095
1096 =item B<--fake> [file]
1097
1098 don't connect to the host using HTTP protocol, instead,
1099 read from WORK_HOME/SITE.in file. The following reads input from
1100 freshmeat.in (downloaded http://freshmeat.net/backend/recentnews.txt) and
1101 saves output to segfault.menu (both files are in WORK_HOME):
1102   fvwm-menu-headlines --site freshmeat --fake --file
1103
1104 =item B<--timeout> seconds
1105
1106 limit a line reading from a socket to this timeout,
1107 the default timeout is 20 seconds.
1108
1109 =back
1110
1111 WORK_HOME of this script is ~/.fvwm/.fvwm-menu-headlines.
1112 It is created if needed.
1113
1114 Option parameters can be specified either using '=' or in the next argument.
1115 Short options are ok if not ambiguous: C<-h>, C<-t>; but be careful with
1116 short options, what is now unambiguous, can become ambiguous in the next
1117 versions.
1118
1119 =head1 USAGE
1120
1121 1. One of the ways to use this script is to define a crontab
1122 entry to run the script every hour or so for every monitored site:
1123
1124   0,30 * * * * fvwm-menu-headlines --file --site freshmeat
1125   1,31 * * * * fvwm-menu-headlines --file --site linuxtoday
1126   2,32 * * * * fvwm-menu-headlines --file --site slashdot
1127
1128 Then add these lines to your fvwm configuration file:
1129
1130   DestroyFunc FuncFvwmMenuHeadlines
1131   AddToFunc   FuncFvwmMenuHeadlines
1132   + I Read "$HOME/.fvwm/.fvwm-menu-headlines/$0.menu"
1133
1134   DestroyMenu MenuHeadlines
1135   AddToMenu   MenuHeadlines "Headlines" Title
1136   + MissingSubmenuFunction FuncFvwmMenuHeadlines
1137   + "FreshMeat"  Popup freshmeat
1138   + "LinuxToday" Popup linuxtoday
1139   + "Slashdot"   Popup slashdot
1140
1141 2. Another way to use this script (only if you have fast network/proxy) is to
1142 run it every time you want to open your Headlines submenus.
1143 (Note, the submenu that is once created is not reloaded, use "Reset all".)
1144
1145 In this case your fvwm configuration lines could be:
1146
1147   DestroyFunc FuncFvwmMenuHeadlines
1148   AddToFunc   FuncFvwmMenuHeadlines
1149   + I PipeRead "fvwm-menu-headlines --site $0"
1150   #+ I Schedule 900000 DestroyMenu $0  # reset generated menu in 15 minutes
1151
1152   DestroyMenu MenuHeadlines
1153   AddToMenu   MenuHeadlines "Headlines" Title
1154   + MissingSubmenuFunction FuncFvwmMenuHeadlines
1155   + "FreshMeat"  Popup freshmeat
1156   + "Slashdot"   Popup slashdot
1157   + "LinuxToday" Popup linuxtoday
1158   + "GNOME News" Popup gnome-news
1159   + "KDE News"   Popup kde-news
1160   + "" Nop
1161   + "Reset all"  FuncResetHeadlines
1162
1163   DestroyFunc FuncResetHeadlines
1164   AddToFunc   FuncResetHeadlines
1165   + I DestroyMenu freshmeat
1166   + I DestroyMenu linuxtoday
1167   + I DestroyMenu slashdot
1168   + I DestroyMenu gnome-news
1169   + I DestroyMenu kde-news
1170
1171 And finally, add "Popup MenuHeadlines" somewhere.
1172
1173 3. Here is a usual usage. Use FvwmConsole or FvwmCommand to run fvwm commands
1174 from a shell script. Every time you want headlines from some site, execute
1175 (give any additional options if you want):
1176
1177   PipeRead "fvwm-menu-headlines --site newsforge --name MenuHeadlinesNewsForge"
1178   # this may take several seconds, you may use: BusyCursor Read true
1179   Popup MenuHeadlinesNewsForge
1180
1181 =head1 HOW TO ADD SITE HEADLINES
1182
1183 It is possible to add user defined site headlines without touching the script
1184 itself. Put your perl extensions to the file WORK_HOME/extension.pl.
1185 For each site add something similar to:
1186
1187   $site_info->{'myslashdot'} = {
1188     'name' => "MySlashdot",
1189     'host' => "myslashdot.org",
1190     'path' => "/myslashdot.xml",
1191     'func' => \&process_my_slashdot,
1192     # the following string is only used in --info
1193     'flds' => 'time, title, department, topic, author, url',
1194   };
1195
1196   sub process_my_slashdot () {
1197     return process_xml(
1198       'story',
1199       # mandatory 'h', 'u' and 'd' aliases or undef
1200       { 'h' => 'title', 'u' => 'url', 'd' => 'time' },
1201       sub ($) {  # convert 'd' string to (y, m, d, H, M, S)
1202         $_[0] =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/;
1203         ($1, ($2 || 0) - 1, $3, $4, $5, $6);
1204       }, +0,  # timezone offset; already in UTC
1205     );
1206   }
1207
1208   1;
1209
1210 =head1 AUTHORS
1211
1212 This script is inspired by WMHeadlines v1.3 by:
1213
1214   Jeff Meininger <jeffm@boxybutgood.com>
1215   (http://rive.boxybutgood.com/WMHeadlines/).
1216
1217 Reimplemented for fvwm and heavily enhanced by:
1218
1219   Mikhael Goikhman <migo@homemail.com>, 16 Dec 1999.
1220
1221 =head1 COPYING
1222
1223 The script is distributed by the same terms as fvwm itself.
1224 See GNU General Public License for details.
1225
1226 =head1 BUGS
1227
1228 I try to keep all supported site info up to date, but sites often go down,
1229 change their backend formats, change their httpd responses, just stop to
1230 post news and so on; the script in the latest cvs may be more up to date.
1231
1232 The headline times may be off by one hour or more, since the time is
1233 displayed for your local time zone, and the time zone of the original time
1234 in the site backend output is often guessed (sometimes incorrectly);
1235 similarly it is guessed whether to apply the daylight saving correction.
1236
1237 Report bugs to fvwm-bug@fvwm.org.
1238
1239 =cut
1240
1241 # ===========================================================================