utils/fvwm-menu-headlines.in

   1 #!@PERL@
   2
   3 # Filter this script to pod2man to get a man page:
   4 #   pod2man -c "Fvwm Utility" fvwm-menu-headlines | nroff -man | less -e
   5
   6 require 5.002;
   7 use strict;
   8 use vars qw($siteInfo @smonths @lmonths %smonthHash %lmonthHash);
   9 use vars qw($entityMap $errorMenuContent);
  10 use Getopt::Long;
  11 use Socket;
  12 use POSIX qw(strftime);
  13 use Time::Local;
  14
  15 my $version = "@VERSION@";
  16
  17 local $siteInfo = {
  18         'freshmeat' => {
  19                 'name' => "FreshMeat",
  20                 'host' => "freshmeat.net",
  21                 'path' => "/backend/recentnews.txt",
  22                 'func' => \&processFreshMeat,
  23                 'flds' => 'headline, date, url',
  24         },
  25         'slashdot' => {
  26                 'name' => "Slashdot",
  27                 'host' => "slashdot.org",
  28                 'path' => "/slashdot.xml",
  29                 'func' => \&processSlashdot,
  30                 'flds' => 'title, url, time, author, department, topic, comments, section, image',
  31         },
  32         'linuxtoday' => {
  33                 'name' => "LinuxToday",
  34                 'host' => "linuxtoday.com",
  35                 'path' => "/lthead.txt",
  36                 'func' => \&processLinuxToday,
  37                 'flds' => 'headline, url, date',
  38         },
  39         'segfault' => {
  40                 'name' => "Segfault",
  41                 'host' => "segfault.org",
  42                 'path' => "/stories.txt",
  43                 'func' => \&processSegfault,
  44                 'flds' => 'headline, url, date, author_name, author_email, type',
  45         },
  46         'appwatch' => {
  47                 'name' => "AppWatch",
  48                 'host' => "www.appwatch.com",
  49                 'path' => "/appwatch.rdf",
  50                 'func' => \&processPoorRdf,
  51                 'flds' => 'title, link, description',
  52         },
  53         'linuxapps' => {
  54                 'name' => "LinuxApps",
  55                 'host' => "www.linuxapps.com",
  56                 'path' => "/backend/linux_basic.txt",
  57                 'func' => \&processLinuxApps,
  58                 'flds' => 'headline, date, url',
  59         },
  60         'justlinux' => {
  61                 'name' => "JustLinux",
  62                 'host' => "www.justlinux.com",
  63                 'path' => "/backend/discussion.rdf",
  64                 'func' => \&processPoorRdf,
  65                 'flds' => 'title, link',
  66         },
  67         'daemonnews' => {
  68                 'name' => "DaemonNews",
  69                 'host' => "daily.daemonnews.org",
  70                 'path' => "/ddn.rdf.php3",
  71                 'func' => \&processPoorRdf,
  72                 'flds' => 'title, link',
  73         },
  74         'gnome-news' => {
  75                 'name' => "GNOME-News",
  76                 'host' => "news.gnome.org",
  77                 'path' => "/rdf",
  78                 'func' => \&process_GNOME_KDE_News,
  79                 'flds' => 'title, link',
  80         },
  81         'kde-news' => {
  82                 'name' => "KDE-News",
  83                 'host' => "news.kde.org",
  84                 'path' => "/rdf",
  85                 'func' => \&process_GNOME_KDE_News,
  86                 'flds' => 'title, link',
  87         },
  88         'freekde' => {
  89                 'name' => "FreeKDE",
  90                 'host' => "freekde.org",
  91                 'path' => "/freekdeorg.rdf",
  92                 'func' => \&processFreeKDE,
  93                 'flds' => 'title, link',
  94         },
  95         'rootprompt' => {
  96                 'name' => "RootPrompt",
  97                 'host' => "rootprompt.org",
  98                 'path' => "/rss/",
  99                 'func' => \&processRootPrompt,
 100                 'flds' => 'title, link, description',
 101         },
 102         'newsforge' => {
 103                 'name' => "NewsForge",
 104                 'host' => "www.newsforge.com",
 105                 'path' => "/newsforge.xml",
 106                 'func' => \&processSlashdot,
 107                 'flds' => 'title, url, time, author, topic, comments, section, image, description',
 108         },
 109         'kuro5hin' => {
 110                 'name' => "Kuro5hin",
 111                 'host' => "www.kuro5hin.org",
 112                 'path' => "/backend.rdf",
 113                 'func' =>  \&processKuro5hin,
 114                 'flds' => 'title, link, description',
 115         },
 116         'bbspot' => {
 117                 'name' => "BBSpot",
 118                 'host' => "bbspot.com",
 119                 'path' => "/bbspot.rdf",
 120                 'func' => \&processPoorRdf,
 121                 'flds' => 'title, link',
 122         },
 123         'linuxfr' => {
 124                 'name' => "LinuxFr",
 125                 'host' => "linuxfr.org",
 126                 'path' => "/short.php3",
 127                 'func' => \&processLinuxFr,
 128                 'flds' => 'headline, url, author_name, author_email, type',
 129         },
 130         'thinkgeek' => {
 131                 'name' => "ThinkGeek",
 132                 'host' => "www.thinkgeek.com",
 133                 'path' => "/thinkgeek.rdf",
 134                 'func' => \&processPoorRdf,
 135                 'flds' => 'title, link',
 136         },
 137 };
 138
 139 # Site specific parsers may use these constants to convert month to unix time.
 140 local @smonths = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 141 local @lmonths = qw(January February March April May June July August September October November December);
 142 local (%smonthHash, %lmonthHash) = ();
 143 foreach (0 .. 11) { $smonthHash{$smonths[$_]} = $_; $lmonthHash{$lmonths[$_]} = $_; }
 144
 145 my $home  = $ENV{'HOME'} || '/tmp';
 146 my $fvwmUserDir = $ENV{'FVWM_USERDIR'} || "$home/.fvwm";
 147 $fvwmUserDir = $home unless -d $fvwmUserDir;
 148 my $workHome = "$fvwmUserDir/.fvwm-menu-headlines";
 149
 150 require "$workHome/extension.pl" if -r "$workHome/extension.pl";
 151
 152 my $info  = undef;
 153 my $defaultSite = 'freshmeat';
 154 my $site  = undef;
 155 my $name  = undef;
 156 my $title = undef;
 157 my $itemF = '%h\t(%[%Y-%m-%d %H:%M])';
 158 my $execF = q(netscape -remote 'openURL(%u, new-window)' || netscape '%u');
 159 my $commF = undef;
 160 my $iconT = '';
 161 my $iconI = '';
 162 my $iconH = '';
 163 my $wmIcons = 0;
 164
 165 my $proxy = undef;
 166 my $port  = 80;
 167 my $frontpage = undef;
 168
 169 my @time  = localtime();
 170 my $menuFile = undef;
 171 my $fakeFile = undef;
 172 my $endl = "\r\n";  # this is preferable for http sockets to "\n"
 173
 174 GetOptions(
 175         "help"     => \&showHelp,
 176         "version"  => \&showVersion,
 177         "info:s"   => \$info,
 178         "site=s"   => \$site,
 179         "name=s"   => \$name,
 180         "title=s"  => \$title,
 181         "item=s"   => \$itemF,
 182         "exec=s"   => \$execF,
 183         "command=s"    => \$commF,
 184         "icon-title=s" => \$iconT,
 185         "icon-item=s"  => \$iconI,
 186         "icon-home=s"  => \$iconH,
 187         "wm-icons" => \$wmIcons,
 188         "proxy=s"  => \$proxy,
 189         "frontpage:s" => \$frontpage,
 190         "file:s"   => \$menuFile,
 191         "fake:s"   => \$fakeFile,
 192 ) || wrongUsage();
 193 wrongUsage() if @ARGV;
 194
 195 if (defined $info) {
 196         if ($info) {
 197                 my $_info = $siteInfo->{lc($info)};
 198                 die "Unsupported site '$info'; try --info.\n" unless $_info;
 199                 print
 200                         "Site Name:\n\t$_info->{'name'}\n",
 201                         "Home Page:\n\thttp://$_info->{'host'}/\n",
 202                         "Headlines:\n\thttp://$_info->{'host'}$_info->{'path'}\n",
 203                         "Headline fields:\n\t$_info->{'flds'}\n";
 204         } else {
 205                 print "All supported sites:\n\t", join(", ", getAllSiteNames()),
 206                         "\n\nSpecify a site name after --info to get a site headlines info.\n";
 207         }
 208         exit(0);
 209 }
 210
 211 $site  ||= $defaultSite; $site = lc($site);
 212 die "Unsupported site '$site'; try --info.\n" unless exists $siteInfo->{$site};
 213 #$name ||= "MenuHeadlines$siteInfo->{$site}->{'name'}";
 214 $name  ||= $site;
 215 $title ||= "$siteInfo->{$site}->{'name'} Headlines";
 216
 217 my $siteName = $siteInfo->{$site}->{'name'};
 218 my $siteHost = $siteInfo->{$site}->{'host'};
 219 my $sitePath = $siteInfo->{$site}->{'path'};
 220 my $siteFunc = $siteInfo->{$site}->{'func'};
 221
 222 $commF ||= "Exec $execF";
 223
 224 $title =~ s/\\t/\t/g;
 225 $itemF =~ s/\\t/\t/g;
 226 $commF =~ s/\\t/\t/g;
 227
 228 if ($wmIcons) {
 229         $iconT ||= "";
 230         $iconI ||= "menu/information.xpm";
 231         $iconH ||= "menu/home.xpm";
 232 }
 233
 234 my $iconTStr = $iconT? "%$iconT%": "";
 235 my $iconIStr = $iconI? "%$iconI%": "";
 236 my $iconHStr = $iconH? "%$iconH%": "";
 237
 238 if (defined $proxy && $proxy =~ /^(.+):(\d+)$/) {
 239         $proxy = $1;
 240         $port = $2;
 241 }
 242
 243 # Three cases:
 244 #   1) no --file option or value '-' specified (STDOUT is used)
 245 #   2) no or empty menu file in --file specified (the default name is used)
 246 #   3) non-empty menu file specified (use it)
 247 $menuFile = undef if defined $menuFile && $menuFile eq '-';
 248 if ($menuFile) {
 249         $menuFile =~ s:^~(/|$):$home$1:;
 250         $menuFile =~ m:^(.+)/[^/]+$:; $workHome = $1 || ".";
 251 } elsif (defined $menuFile) {
 252         $menuFile = "$workHome/$site.menu";
 253 }
 254
 255 my $content = "";
 256
 257 $content .= qq(DestroyMenu $name\n);
 258 $content .= qq(AddToMenu $name "$iconTStr$title" Title\n);
 259 local $errorMenuContent = $content . "+ `<msg>` DestroyMenu $name\n";
 260
 261 if (defined $frontpage && $frontpage !~ /^b/) {
 262         my $cmd = expandAllWidthSpecifiers($commF, {'u' => "http://$siteHost/"});
 263         $content .= qq(+ "$iconHStr$siteName Frontpage" $cmd\n);
 264         $content .= qq(+ "" Nop\n);
 265 }
 266
 267 unless (defined $fakeFile) {
 268         # network connection portion is pretty much stolen from 'man perlipc'
 269         my $host = $proxy || $siteHost;
 270         my $iaddr = inet_aton($host) || dieNet("Can't resolve host $host");
 271         my $paddr = sockaddr_in($port, $iaddr);
 272         my $proto = getprotobyname('tcp');
 273         socket(SOCK, PF_INET, SOCK_STREAM, $proto) &&
 274                 connect(SOCK, $paddr) || dieNet("Can't connect host $host");
 275         select(SOCK); $| = 1; select(STDOUT);
 276
 277         # do http request
 278         my $httpHeaders = "$endl" .
 279                         "Host: $siteHost$endl" .
 280                         "Connection: close$endl" .
 281                         "User-Agent: fvwm-menu-headlines/$version$endl$endl";
 282         if (defined $proxy) {
 283                 print SOCK "GET http://$siteHost$sitePath HTTP/1.1$httpHeaders";
 284         } else {
 285                 print SOCK "GET $sitePath HTTP/1.1$httpHeaders";
 286         }
 287
 288         # skip http response headers
 289         while (<SOCK> !~ /^\r?\n$/s) {}
 290 } else {
 291         if ($fakeFile) {
 292                 $fakeFile =~ s:^~(/|$):$home$1:;
 293         } else {
 294                 $fakeFile = "$workHome/$site.in";
 295         }
 296         open(SOCK, "<$fakeFile") || dieSys("Can't open $fakeFile");
 297 }
 298
 299 my $entries = &$siteFunc;
 300
 301 close(SOCK) || dieNet("Error closing socket");
 302
 303 foreach (@$entries) {
 304         my $text = expandAllWidthSpecifiers($itemF, $_);
 305         my $comm = expandAllWidthSpecifiers($commF, $_);
 306         $text =~ s/"/\\"/g;
 307         $content .= qq(+ "$iconIStr$text" $comm\n);
 308 }
 309
 310 if (defined $frontpage && $frontpage =~ /^b/) {
 311         my $cmd = expandAllWidthSpecifiers($commF, {'u' => "http://$siteHost/"});
 312         $content .= qq(+ "" Nop\n);
 313         $content .= qq(+ "$iconHStr$siteName Frontpage" $cmd\n);
 314 }
 315
 316 if (defined $menuFile) {
 317         unless (-d $workHome) {
 318                 mkdir($workHome, 0775) || dieSys("Can't create $workHome");
 319         }
 320         open(MENU_FILE, ">$menuFile") || dieSys("Can't open $menuFile");
 321         print MENU_FILE $content;
 322         close(MENU_FILE) || dieSys("Can't close $menuFile");
 323 } else {
 324         print $content;
 325 }
 326
 327 exit();
 328
 329 # ---------------------------------------------------------------------------
 330
 331 # make unix time from year (2001 or 101), mon (0..11), day, hour, min, sec
 332 sub makeTime {  # ($$$$$$$)
 333         my ($year, $mon, $day, $hour, $min, $sec, $hourD) = @_;
 334         $year = 1973 unless $year && $year > 0;  # it's my year :-)
 335         $mon  = 0 unless $mon && $mon > 0 && $mon <= 11;
 336         $day  = 1 unless $day && $day > 0 && $day <= 31;
 337         $hour = 0 unless $hour && $hour >= 0 && $hour < 24;
 338         $min  = 0 unless $min && $min >= 0 && $min < 60;
 339         $sec  = 0 unless $sec && $sec >= 0 && $sec < 60;
 340
 341         return timegm($sec, $min, $hour, $day, $mon, $year) - $hourD * 60 * 60;
 342 }
 343
 344 sub setEntryAliasesAndTime ($$$$) {
 345         my $entry = shift;
 346         my $aliases = shift;
 347         my $timeSub = shift;
 348         my $hOffset = shift;
 349
 350         my ($alias, $orig);
 351         while (($alias, $orig) = each %$aliases) {
 352                 $entry->{$alias} = !$orig? "":
 353                         ref($orig) eq 'CODE'? &{$orig}($entry): $entry->{$orig};
 354                 $entry->{$alias} = "" unless defined $entry->{$alias};
 355         }
 356
 357         $entry->{'_'} = makeTime(&{$timeSub}($entry->{'d'}), $hOffset);
 358 }
 359
 360 BEGIN {
 361         $entityMap = {
 362                 'gt'    => '>',
 363                 'lt'    => '<',
 364                 'quot'  => '"',
 365                 'amp'   => '&',
 366         };
 367 }
 368
 369 sub processXml ($$$$) {
 370         my $entryTag = shift;
 371         my $aliases = shift;
 372         my $timeSub = shift;
 373         my $hOffset = shift;
 374         my @entries = ();
 375         my $doc = join("", <SOCK>);
 376         print STDERR $doc if $ENV{"DEBUG_DUMP_RESPONSE"};
 377
 378         ENTRY:
 379         foreach ($doc =~ m!<$entryTag\b[^>]*>(.*?)</$entryTag>!sg) {
 380                 # replace &#039; with single quote and &quot; with double quote
 381                 s/&(?:(\w+)|#(\d+));/ $1? $entityMap->{$1} || "{$1}": chr($2) /ge;
 382
 383                 my $entry = {};
 384
 385                 foreach (m!(<.*?>.*?</.*?>)!sg) {
 386                         m!<(.*?)>\s*(.*?)\s*</(.*?)>!s;
 387                         # ignore incorect fields or throw error?
 388                         next unless $1 && $2 && $3;
 389                         next if $1 ne $3;
 390                         $entry->{$1} = $2;
 391                 }
 392
 393                 setEntryAliasesAndTime($entry, $aliases, $timeSub, $hOffset);
 394                 push @entries, $entry;
 395         }
 396         return \@entries;
 397 }
 398
 399 sub processText ($$$$) {
 400         my $fields = shift;
 401         my $aliases = shift;
 402         my $timeSub = shift;
 403         my $hOffset = shift;
 404         my @entries = ();
 405
 406         ENTRY:
 407         while (1) {
 408                 my $entry = {};
 409                 foreach (@$fields) {
 410 #                       my $line = undef;
 411 #                       ### It waits 15 seconds until returning last undef :-(
 412 #                       eval {
 413 #                               local $SIG{ALRM} = sub { die "\n"; };
 414 #                               alarm(1); $line = <SOCK>; alarm(0);
 415 #                       };
 416                         my $line = <SOCK>;
 417                         last ENTRY unless defined $line;
 418                         next if $_ eq '_ignore_';
 419                         print STDERR $line if $ENV{"DEBUG_DUMP_RESPONSE"};
 420
 421                         chomp($line);
 422                         $line =~ s/"/\\"/g;
 423 #                       $line =~ s/<.*?>//g;
 424 #                       $line =~ s/&\w{1,5}?;/ /g;
 425                         $entry->{$_} = $line;
 426                 }
 427
 428                 setEntryAliasesAndTime($entry, $aliases, $timeSub, $hOffset);
 429                 push @entries, $entry;
 430         }
 431         return \@entries;
 432 }
 433
 434 sub processSlashdot () {
 435         return processXml(
 436                 'story',
 437                 { 'h' => 'title', 'u' => 'url', 'd' => 'time' },
 438                 sub ($) {
 439                         $_[0] =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/;
 440                         ($1, ($2 || 0) - 1, $3, $4, $5, $6);
 441                 }, +0,
 442         );
 443 }
 444
 445 sub processFreshMeat () {
 446         return processText(
 447                 [ qw( headline date url ) ],
 448                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 449                 sub ($) {
 450                         $_[0] =~ /^(?:\w+, )?(\w+) (\d+)\w* (\d+),? (\d+):(\d+)/;
 451                         ($3, $lmonthHash{$1}, $2, $4, $5, 0);
 452                 }, -5 + (abs((localtime())[4] - 5.5) < 3),
 453         );
 454 }
 455
 456 sub processLinuxToday () {
 457         while (<SOCK>) {
 458                 last if /linuxtoday.com/;  # skip the text note
 459                 last if /&&/ and <SOCK> x 3;  # if the note was changed
 460         }
 461         return processText(
 462                 [ qw( _ignore_ headline url date ) ],
 463                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 464                 sub ($) {
 465                         $_[0] =~ /(\w+) (\d+), (\d+), (\d+):(\d+):(\d+)/;
 466                         ($3, $smonthHash{$1}, $2, $4, $5, $6);
 467                 }, +0,
 468         );
 469 }
 470
 471 sub processSegfault () {
 472         while (<SOCK>) {
 473                 last if /^%%/;  # skip the text note
 474         }
 475         return processText(
 476                 [ qw( headline url date author_name author_email type _ignore_ ) ],
 477                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 478                 sub ($) {
 479                         $_[0] =~ /(\d+) (\w+) (\d+):(\d+):(\d+) (\d+)/;
 480                         ($6, $smonthHash{$2}, $1, $3, $4, $5);
 481                 }, -8 + (abs((localtime())[4] - 5.5) < 3),
 482         );
 483 }
 484
 485 sub processPoorRdf () {
 486         return processXml(
 487                 'item',
 488                 { 'h' => 'title', 'u' => 'link', 'd' => undef },
 489                 sub ($) {
 490                         # this site's rdf does not supply the time, how weird...
 491                         (gmtime())[5,4,3,2,1,0];
 492                 }, +0,
 493         );
 494 }
 495
 496 sub processLinuxApps () {
 497         return processText(
 498                 [ qw( headline date url ) ],
 499                 { 'h' => 'headline', 'u' => 'url', 'd' => 'date' },
 500                 sub ($) {
 501                         $_[0] =~ /(\w+) (\d+) (\d+):(\d+):(\d+) \w+ (\d+)/;
 502                         ($6, $smonthHash{$1}, $2, $3, $4, $5);
 503                 }, -5,
 504         );
 505 }
 506
 507 sub process_GNOME_KDE_News () {
 508         my $linkToTime = sub ($) { $_[0]->{'link'} =~ m|/(\d+)/?$|; $1; };
 509         return processXml(
 510                 'item',
 511                 { 'h' => 'title', 'u' => 'link', 'd' => $linkToTime },
 512                 sub ($) {
 513                         (gmtime($_[0]))[5,4,3,2,1,0];
 514                 }, +0,
 515         );
 516 }
 517
 518 sub processFreeKDE () {
 519         my $linkToDate = sub ($) {
 520                 $_[0]->{'link'} =~ m|/(\d\d/\d\d/\d\d)/|; $1? "20$1": '';
 521         };
 522         return processXml(
 523                 'item',
 524                 { 'h' => 'title', 'u' => 'link', 'd' => $linkToDate },
 525                 sub ($) {
 526                         $_[0] =~ m|(\d+)/(\d+)/(\d+)|;
 527                         ($1, ($2 || 0) - 1, $3);
 528                 }, +0,
 529         );
 530 }
 531
 532 sub processRootPrompt () {
 533         my $descToDate = sub ($) {
 534                 $_[0]->{'description'} =~ /^(\d+ \w{3} \d{4}):/; $1;
 535         };
 536         return processXml(
 537                 'item',
 538                 { 'h' => 'title', 'u' => 'link', 'd' => $descToDate },
 539                 sub ($) {
 540                         $_[0] =~ /(\d+) (\w+) (\d+)/;
 541                         ($3, $smonthHash{$2}, $1);
 542                 }, +0,
 543         );
 544 }
 545
 546 sub processKuro5hin () {
 547         my $linkToDate = sub ($) {
 548                 $_[0]->{'link'} =~ m|sid=(\d\d\d\d/\d{1,2}/\d{1,2})/|; $1;
 549         };
 550         return processXml(
 551                 'item',
 552                 { 'h' => 'title', 'u' => 'link', 'd' => $linkToDate },
 553                 sub ($) {
 554                         $_[0] =~ m|(\d+)/(\d+)/(\d+)|;
 555                         ($1, ($2 || 0) - 1, $3);
 556                 }, +0,
 557         );
 558 }
 559
 560 sub processLinuxFr () {
 561         my $linkToDate = sub ($) {
 562                 $_[0]->{'url'} =~ m|/(\d\d\d\d/\d\d/\d\d)/|; $1;
 563         };
 564         my $hackForUrl = sub ($) {
 565                 # hack for netscape -remote openURL
 566                 my $u = $_[0]->{'url'};
 567                 $u =~ s|,|\%2c|g; $u;
 568         };
 569         while (<SOCK>) {
 570                 last if /^%%/;  # skip the text note
 571         }
 572         return processText(
 573                 [ qw( headline url author_name author_email type _ignore_ ) ],
 574                 { 'h' => 'headline', 'u' => $hackForUrl, 'd' => $linkToDate },
 575                 sub ($) {
 576                         $_[0] =~ m|(\d+)/(\d+)/(\d+)|;
 577                         ($1, ($2 || 0) - 1, $3);
 578                 }, +0,
 579         );
 580 }
 581 # ---------------------------------------------------------------------------
 582
 583 sub dieSys ($) {
 584         my $msg = shift;
 585         $msg = "$0: $msg: [$!]\n";
 586
 587         print STDERR $msg
 588 #               # be quiet in non interactive shells?
 589 #               if ($ENV{'SHLVL'} || 0) == 1 || defined($ENV{'PS1'})
 590                 ;
 591         exit(-1);
 592 }
 593
 594 sub dieNet ($) {
 595         my $msg = shift;
 596
 597         #dieSys($msg);
 598         $errorMenuContent =~ s/<msg>/$msg; check network connection/;
 599         print $errorMenuContent;
 600         exit(-1);
 601 }
 602
 603 # like strftime, but gets unix time, instead of sec/min/hour/day/mon/year.
 604 sub formatTime ($$) {
 605         my ($fmt, $time) = @_;
 606         $time ||= time();
 607         strftime($fmt, localtime($time));
 608 }
 609
 610 # Substitutes all %N1*N2x in $name by properly stripped and justified $values.
 611 # $name example: %[%d %b %y %H:%M], %*-7(some text), %-32*30h, %{url}.
 612 # $values is a hash of named values to substitute.
 613 sub expandAllWidthSpecifiers ($$) {
 614         my ($name, $values) = @_;
 615         $name =~ s/%(-?\d+)?(\*(-?)(\d+))?(\w|{\w+}|\(.*?\)|\[.*?\])/
 616                 my $tag = substr($5, 0, 1);
 617                 my $arg = length($5) == 1? $5: substr($5, 1, -1);
 618                 my $value =
 619                         $tag eq '('? $arg:
 620                         $tag eq '['? formatTime($arg, $values->{'_'}):
 621                         $values->{$arg};
 622                 $value = "(%$5 is not defined)" unless defined $value;
 623                 $value = !$2 || $4 <= 3 || $4 > length($value)? $value: $3?
 624                         "..." . substr($value, -$4 + 3, $4 - 3):
 625                         substr($value, 0, $4 - 3) . "...";
 626                 $1? sprintf("%$1s", $value): $value;
 627         /ge;
 628         return $name;
 629 }
 630
 631 sub getAllSiteNames () {
 632         return sort map { $siteInfo->{$_}->{'name'} } keys %$siteInfo;
 633 }
 634
 635 sub showHelp {
 636         $site  ||= $defaultSite;
 637         #$name ||= "MenuHeadlines$siteInfo->{$site}->{'name'}";
 638         $name  ||= $site;
 639         $title ||= "$siteInfo->{$site}->{'name'} Headlines";
 640
 641         print "A perl script which builds headlines menu for fvwm.\n";
 642         print "Supported sites: ", join(', ', getAllSiteNames()), "\n\n";
 643         print "Usage: $0 [OPTIONS]\n";
 644         print "Options:\n";
 645         print "\t--help           show this help and exit\n";
 646         print "\t--version        show the version and exit\n";
 647         print "\t--info=[NAME]    information about a site\n";
 648         print "\t--site=NAME      headlines site, default is $site\n";
 649         print "\t--name=NAME      menu name,  default is '$name'\n";
 650         print "\t--title=NAME     menu title, default is '$title'\n";
 651         print "\t--item=FORMAT    menu item format, default is '$itemF'\n";
 652         print "\t--exec=FORMAT    exec command, default is {$execF}\n";
 653         print "\t--command=FORMAT fvwm command, default is no\n";
 654         print "\t--icon-title=XPM menu title icon, default is no\n";
 655         print "\t--icon-item=XPM  menu item  icon, default is no\n";
 656         print "\t--icon-home=XPM  menu home  icon, default is no\n";
 657         print "\t--wm-icons       define icon names to use with wm-icons\n";
 658         print "\t--frontpage[=V]  show frontpage item; values: top, bottom\n";
 659         print "\t--proxy=host[:port] specify proxy host and port (80)\n";
 660         print "\t--file[=FILE]    menu file, default is $workHome/$site.menu\n";
 661         print "\t--fake[=FILE]    don't connect, read input from file\n";
 662         print "Short options are ok if not ambiguous: -h, -t.\n";
 663         exit 0;
 664 }
 665
 666 sub showVersion {
 667         print "$version\n";
 668         exit 0;
 669 }
 670
 671 sub wrongUsage {
 672         print STDERR "Try '$0 --help' for more information.\n";
 673         exit -1;
 674 }
 675
 676 __END__
 677
 678 # ---------------------------------------------------------------------------
 679
 680 =head1 NAME
 681
 682 fvwm-menu-headlines - builds headlines menu definition for FVWM
 683
 684 =head1 SYNOPSIS
 685
 686 B<fvwm-menu-headlines>
 687 [ B<--help>|B<-h> ]
 688 [ B<--version>|B<-v> ]
 689 [ B<--info> [site] ]
 690 [ B<--site>|B<-s> site ]
 691 [ B<--name>|B<-n> name ]
 692 [ B<--title>|B<-t> title ]
 693 [ B<--item> item ]
 694 [ B<--exec>|B<-e> exec-command ]
 695 [ B<--command>|B<-e> fvwm-command ]
 696 [ B<--icon-title> icon ]
 697 [ B<--icon-item> icon ]
 698 [ B<--icon-home> icon ]
 699 [ B<--wm-icons> ]
 700 [ B<--frontpage> [where] ]
 701 [ B<--proxy>|B<-p> host:port ]
 702 [ B<--file> [file] ]
 703 [ B<--fake> [file] ]
 704
 705 =head1 DESCRIPTION
 706
 707 This configurable perl script builds an fvwm menu definition for headlines
 708 of popular news web sites: FreshMeat, Slashdot, LinuxToday, Segfault, AppWatch,
 709 LinuxApps, JustLinux, DaemonNews, GNOME-News, KDE-News, FreeKDE, RootPrompt,
 710 LinuxFr, ThinkGeek and more.
 711
 712 It is possible to specify a customized menu item format, change a command
 713 (usually launching a browser) and add menu icons (there is a support for
 714 the wm-icons package).
 715
 716 =head1 OPTIONS
 717
 718 B<--help>    - show the help and exit
 719
 720 B<--version> - show the version and exit
 721
 722 B<--info> [site] - if site name is given print the site specific info,
 723 otherwise print all site names
 724
 725 B<--site> site - defile a web site, headlines of which to show, this option
 726 also can be used together with --help to get new defaults.
 727 Default site: freshmeat.
 728
 729 B<--name>, B<--title>, B<--icon> - define menu name, menu title and menu icon
 730 accordingly given in the following argument. Default is name
 731 "MenuHeadlinesFreshmeat", title "Freshmeat Headlines" and no mini-icon
 732 (equivalent to an empty icon argument).
 733
 734 B<--item>, B<--exec> - define menu item or exec format in the following
 735 argument (what is shown and what is executed when the item is chosen),
 736 default is '%h\t(%[%Y-%m-%d %H:%M])'.
 737 TAB can be specified as '\t', but in .fvwm2rc you should specify a double
 738 backslash or a real TAB.
 739
 740 Format specifiers for a headline entry:
 741   %h - headline
 742   %u - url
 743   %d - date in native format
 744   %[strftime-argument-string] - date, see strftime(3)
 745     the date is represented accourding to the local time
 746   %{name} - site-specific-named-value
 747   %(text) - arbitrary text
 748
 749 These specifiers can receive an optional integer size, positive for right
 750 adjusted string or negative for left adjusted, example: %8x; and optional
 751 *num or *-num, which means to leave only the first or last (if minus) num of
 752 chars, the num must be greater than 3, since the striped part is replaced
 753 with "...", example: %*30x. Both can be combined: %-10*-20x, this instructs to
 754 get only the 20 last characters, but if the length is less then 10 - to fill
 755 with up to 10 spaces on the right.
 756
 757 B<--command> like B<--exec> above, but enables to specify any fvwm command,
 758 for example, "Function FuncFvwmShowURL '%u'" not only Exec.
 759
 760 In fact, --exec="mozilla '%u'" is equivalent
 761 to --command="Exec mozilla '%u'"
 762
 763 B<--icon-title>, B<--icon-item>, B<--icon-home> - define menu icon for
 764 title, regular item and home item respectively given in the following argument.
 765 Default is no menu icons (equivalent to an empty icon argument).
 766
 767 B<--wm-icons> - define icon names suitable for use with wm-icons package.
 768 Currently this is equivalent to: --icon-title '' --icon-item
 769 menu/information.xpm --icon-home menu/home.xpm.
 770
 771 B<--frontpage> [where] - show site fronpage item in the menu too. Optional
 772 value can be used to specify where this item will be placed in the menu -
 773 'top' or 't', 'bottom' or 'b'.
 774
 775 B<--proxy> host[:port] - define a proxy to use.
 776 Example: --proxy proxy.inter.net:3128
 777
 778 B<--file> [file] - write the menu output to specified file. If no filename is
 779 given with this option (or empty filename), the default filename
 780 WORK_HOME/SITE.menu is used. Without this option or with '-'
 781 filename, the menu output is written to standard output.
 782
 783 B<--fake> [file] - don't connect to the host using HTTP protocol, instead,
 784 read from WORK_HOME/SITE.in file. The following reads input from
 785 segfault.in (downloaded http://segfault.org/stories.txt) and saves output
 786 to segfault.menu (both files are in WORK_HOME):
 787   fvwm-menu-headlines --site segfault --fake --file
 788
 789 WORK_HOME of this script is ~/.fvwm/.fvwm-menu-headlines.
 790 It is created if needed.
 791
 792 Option parameters can be specified both using '=' and in the next argument.
 793 Short options are ok if not ambiguous: C<-h>, C<-t>; but be careful with
 794 short options, what is now unambiguous, can become ambiguous in the next
 795 versions.
 796
 797 =head1 USAGE
 798
 799 1. One of the ways to use this script is to define a crontab
 800 entry to run the script every hour or so for every monitored site:
 801
 802   0,30 * * * * fvwm-menu-headlines --file --site freshmeat
 803   1,31 * * * * fvwm-menu-headlines --file --site linuxtoday
 804   2,32 * * * * fvwm-menu-headlines --file --site slashdot
 805
 806 Then add these lines to your fvwm configuration file:
 807
 808   DestroyFunc FuncFvwmMenuHeadlines
 809   AddToFunc   FuncFvwmMenuHeadlines
 810   + I Read "$HOME/.fvwm/.fvwm-menu-headlines/$0.menu"
 811
 812   DestroyMenu MenuHeadlines
 813   AddToMenu   MenuHeadlines "Headlines" Title
 814   + MissingSubmenuFunction FuncFvwmMenuHeadlines
 815   + "FreshMeat"  Popup freshmeat
 816   + "LinuxToday" Popup linuxtoday
 817   + "Slashdot"   Popup slashdot
 818
 819 2. Another way to use this script (only if you have fast network/proxy) is to
 820 run it every time you want to open your Headlines submenus.
 821 (Note, the submenu that is once created is not reloaded, use "Reset all".)
 822
 823 In this case your fvwm configuration lines could be:
 824
 825   DestroyFunc FuncFvwmMenuHeadlines
 826   AddToFunc   FuncFvwmMenuHeadlines
 827   + I PipeRead "fvwm-menu-headlines --site $0"
 828
 829   DestroyMenu MenuHeadlines
 830   AddToMenu   MenuHeadlines "Headlines" Title
 831   + MissingSubmenuFunction FuncFvwmMenuHeadlines
 832   + "FreshMeat"  Popup freshmeat
 833   + "Slashdot"   Popup slashdot
 834   + "LinuxToday" Popup linuxtoday
 835   + "Segfault"   Popup segfault
 836   + "AppWatch"   Popup appwatch
 837   + "GNOME News" Popup gnome-news
 838   + "KDE News"   Popup kde-news
 839   + "" Nop
 840   + "Reset all"  FuncResetHeadlines
 841
 842   DestroyFunc FuncResetHeadlines
 843   AddToFunc   FuncResetHeadlines
 844   + I DestroyMenu freshmeat
 845   + I DestroyMenu linuxtoday
 846   + I DestroyMenu slashdot
 847   + I DestroyMenu segfault
 848   + I DestroyMenu appwatch
 849   + I DestroyMenu gnome-news
 850   + I DestroyMenu kde-news
 851
 852 And finally, add "Popup MenuHeadlines" somewhere.
 853
 854 3. Here is a usual usage. Use FvwmConsole or FvwmCommand to run fvwm commands
 855 from a shell script. Every time you want headlines from some site, execute
 856 (give any additional options if you want):
 857
 858   PipeRead "fvwm-menu-headlines --site segfault --name MenuHeadlinesSegfault"
 859   # this will take several seconds, you may use: BusyCursor Read true
 860   Popup MenuHeadlinesSegfault
 861
 862 =head1 HOW TO ADD SITE HEADLINES
 863
 864 It is possible to add user defined site headlines without touching the script
 865 itself. Put your perl extensions to the file WORK_HOME/extension.pl.
 866 For each site add something similar to:
 867
 868   $siteInfo->{'myslashdot'} = {
 869     'name' => "MySlashdot",
 870     'host' => "myslashdot.org",
 871     'path' => "/myslashdot.xml",
 872     'func' => \&processMySlashdot,
 873     # the following string is only used in --info
 874     'flds' => 'time, title, department, topic, author, url',
 875   };
 876
 877   sub processMySlashdot () {
 878     return processXml(
 879       'story',
 880       # mandatory 'h', 'u' and 'd' aliases or undef
 881       { 'h' => 'title', 'u' => 'url', 'd' => 'time' },
 882       sub ($) {  # convert 'd' string to (y, m, d, H, M, S)
 883         $_[0] =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/;
 884         ($1, ($2 || 0) - 1, $3, $4, $5, $6);
 885       }, +0,  # timezone offset; already in UTC
 886     );
 887   }
 888
 889   1;
 890
 891 =head1 AUTHORS
 892
 893 This script is inspired by WMHeadlines v1.3 by:
 894
 895   Jeff Meininger <jeffm@boxybutgood.com>
 896   (http://rive.boxybutgood.com/WMHeadlines/).
 897
 898 Reimplemented for FVWM and heavily enhanced by:
 899
 900   Mikhael Goikhman <migo@homemail.com>, 16 Dec 1999.
 901
 902 =head1 COPYING
 903
 904 The script is distributed by the same terms as fvwm itself.
 905 See GNU General Public License for details.
 906
 907 =head1 BUGS
 908
 909 Report bugs to fvwm-bug@fvwm.org.
 910
 911 =cut
 912
 913 # ===========================================================================