#!/usr/bin/perl -X
# vim: foldmethod=marker
use strict;
use warnings;
use 5.010;
use utf8;use open qw/:std :utf8/;
use ORFText;
=pod
TODO: %headings won't register when topstory is missing (->sportarten)
this is version 2.0 of ttxd
values for query string/cookie:
- special flags start with _
- _noqna: hide "fragen/antworten" (set by default)
- numeric: pagenumbers
=cut
my $pages = $ENV{HTTP_COOKIE} // join '&', (
101, 113 .. 125, # Politik: Österreich/EU
127 .. 134, # Politik: International
102,#136 .. 144, # Chronik
# 701 .. 709 # Bundesländer (W-NÖ-B-OÖ-S-T-V-K-St)
# 471 .. 478 # Nachrichten leicht verständlich
# 103, 146 .. 149 # Leute
# 104, 151 .. 159 # Wirtschaft
# 161,167,169, # Börse
# 170,172,174 # -"-
# 105, 203 .. 209, # Sport vom Tag
# 210 .. 259, # Sportarten
# 261 .. 278, # Wintersport & Großereignisse
# 107,110,191..198, # Show und Kultur
108,#461 .. 465, # Web/Media
# 468 .. 469, # Webtipps
# Special Flags:
"_noqna", # hide Q-and-A
);
my @pages = split /&/, ($ENV{QUERY_STRING} =~ s/(\d{3})-(\d{3})/${\join'&',$1..$2}/gr) // $pages;
# pages from query string won't affect cookie
#print "Set-Cookie: $pages; Max-Age=2147483647\r\n";
print "Content-type: text/html\r\n\r\n";
# html format {{{
$ORFText::REF_MARKUP = sub {
return qq{$_[0]$_[1]}
};
sub format_table {
my $text = join("\n",map{s/[\x00-\x20]/ /gr}@{%{$_[0]}{raw}})=~s/^ ,,+//msr=~s/\n+$//r;
return {%$_, text=>"
$text
"};
}
sub format_html { my %page = %{$_[0] or return};
no warnings 'numeric';
use List::Util qw[max];
sub ifdef { $_[1]? "$_[0]$_[1]":"" }
my $pagespec = substr($page{page},0,1) ."00/$page{page}_000".max($page{subpage},1);
return <<"HTML";
$page{text}
➤
${\($page{advert}=~s|\b(\d{3})\b|$1|gr)}
HTML
}
# }}}
# headings {{{
my %headings = (
101 => "Politik: Österreich/EU",
127 => "Politik: International",
102 => "Chronik",
103 => "Leute",
104 => "Wirtschaft",
161 => "Börse",
105 => "Sport",
#203 => "Sport vom Tag",
#260 => "Wintersport und Großereignisse"
106 => "Fernsehen",
108 => "Multimedia",
107 => "Kultur & Show", # XXX: this will show it multiple times!
110 => "Kultur & Show",
109 => "Wetter",
471 => "Nachrichten leicht verständlich",
481 => "Nachrichten leichter verständlich",
701 => "Wien",
702 => "Niederösterreich",
703 => "Burgenland",
704 => "Oberösterreich",
705 => "Salzburg",
706 => "Tirol",
707 => "Vorarlberg",
708 => "Kärnten",
709 => "Steiermark",
);
# }}}
# html-head {{{
print <<'EOF';
ORFText News
EOF
# }}}
my (@all, @nonempty);
page:foreach (grep/[0-9]/,@pages) {
print "$headings{$_}
\n" if $headings{$_};
my $pageno = $_;
push @all, $pageno;
foreach (glob "/run/ttxd/spool/2/${_}_*.vtx") {
my $file_age = time - (stat)[9];
next if $file_age > 300;
for (ORFText::html($_)) {
next unless $_; # fail req'd for $nonempty
if ("_noqna" ~~ @pages) { # hide Q-and-A
next page if %{$_}{text}=~m@[Aa]lle Fra.?gen/Antworten.+?500@;# /.?/ is a soft hyphen
}
$_ = format_table $_ if %$_{tabular};
print format_html $_ ;
push @nonempty, $pageno;
}
}
}
sub subtr { return grep{not%{{map{$_=>1}@{$_[1]}}}{$_}} @{$_[0]}; }
sub uniq { return sort keys %{{@_}}; }
my @empty = uniq subtr [sort @all], [@nonempty]; # WARN: uniq breaks when sort is removed!
my ($N, $n) = ('n'x!!$#empty, 'n'x!!$#all);
print "";
print "Tafel$N @{[join ', ', @empty]} wurde$N nicht gefunden. " if @empty;
print "
";
print "";
print "
".join ' | ', (
'Politik',
'Chronik',
'Bundesländer',
'einfache Sprache',
'Leute',
'Multimedia',
'Kultur & Show',
'Wirtschaft',
'Börse',
'Sport',
'Topstories',
);
print "
";
print "";