#!/usr/bin/perl
# dumps "interesting" data about tv channels
use Getopt::Long;
use Video::Frequencies;
use Video::Capture::V4l;
use Video::Capture::VBI qw/:DEFAULT %VPS_CNI %VT_NI/;
use Video::XawTV;
GetOptions "+verbose|v" => \$verbose
or exit 1;
$rc = new Video::XawTV;
eval { $rc->load("$ENV{HOME}/.xawtv") };
$ftab = $rc->opt('freqtab') || "pal-europe";
$freq = $CHANLIST{$ftab} or die "no such frequency table: $ftab";
$v4l = new Video::Capture::V4l;
$tuner = $v4l->tuner(0);
$channel = $v4l->channel(0);
$tuner->mode(MODE_PAL); $tuner->set;
$channel->norm(MODE_PAL); $channel->set;
$vbi = new Video::Capture::V4l::VBI or die;
$vbi_fd = $vbi->fileno;
$|=1;
my @channels;
for $chan (sort keys %$freq) {
my $f = $freq->{$chan};
print "tuning to $chan ($f)...";
$v4l->freq($f);
select undef,undef,undef,0.2; # shit!
$vbi->backlog (10);
%fea = ();
scan_vbi (50);
$vbi->backlog (0);
if ($tuner->signal > 30000) {
my $cni = $VPS_CNI{$fea{CNI} & 0xfff};
my $ni = $VT_NI{$fea{NI}};
my $name;
if (defined $ni) {
$name = "$ni->[0] ($ni->[1])";
} elsif (defined $cni) {
$name = $cni;
} elsif ($fea{NAME}) {
$name = $fea{NAME};
} elsif (length $fea{VT} > 1) {
$name = $fea{VT};
} else {
$name = "channel $chan";
}
$name =~ s/\s*"\s*/ /g;
$name =~ s/\s*\(.*?\)\s*/ /g;
$name =~ s/^\s+//;
$name =~ s/\s+$//;
print " $name";
print " [";
while(my($k,$v)=each %fea) {
print " $k","[$v]";
}
print " ]";
my $c = { name => $name, channel => $chan, capture => 'on' };
if (1||$verbose) {
$c->{features} = join(":", %fea);
}
my $key = find_key ($name);
$c->{key} = $key if $key;
push @channels, $c;
} else {
print " no signal";
}
print "\n";
}
$rc->channels(@channels);
$rc->save("xawtvrc");
print "\nnew xawtvrc saved as ./xawtvrc\n";
sub scan_vbi {
my $frames = shift;
my($name_,$name,$name2);
while ($frames) {
my $vbi_alloc;
$tuner->get; return if $tuner->signal < 30000;
$frames--;
return if (defined $VT_NI{$fea{NI}} || defined $VPS_CNI{$fea{CNI}}) && !$verbose;
for (decode_field $vbi->field, VBI_VT|VBI_VPS|VBI_OTHER|VBI_EMPTY) {
if ($_->[0] == VBI_VPS) {
$fea{CNI}=$_->[3];
if (ord($_->[1]) > 127 or length $name_ >= 12) {
if ($name eq $name_) {
$fea{NAME}=$name;
}
$name = $name_;
}
$name_ .= $_->[1] & "\x7f";
$fea{VPS}=sprintf "%04x", $_->[3];
$vbi_alloc .= "V";
} elsif ($_->[0] == VBI_VT) {
if ($_->[2] == 0) {
if ($_->[4] == 0x1df) {
$fea{EPG}="";
} else {
$fea{VT}=vt_2_name($_->[3]);
}
} elsif ($_->[2] == 30) {
if (($_->[3]>>1) == 0) {
$fea{NI} = $_->[6];
$fea{'NI30/1'}=sprintf "%04x", $_->[6];
} elsif (($_->[3]>>1) == 8) {
$fea{PDC}="";
} else {
$fea{"30"}="$_->[3]";
}
} elsif ($_->[2] == 31) {
if ($_->[4] == 0x500) {
$fea{"$_->[1]/IC"}="";
} else {
$fea{sprintf "$_->[1]/31[%x]",$_->[4]}++;
}
}
$vt++;
$vbi_alloc .= "T";
} elsif ($_->[0] == VBI_OTHER) {
$vbi_alloc .= $_->[1] == 1 ? "c" : "O";
} elsif ($_->[0] == VBI_EMPTY) {
$vbi_alloc .= ".";
} else {
$others++;
}
}
$fea{ALLOC}=$vbi_alloc;
select undef,undef,undef,0.1 unless $vbi->queued;
}
}
# try to guess sender name from videotext
sub vt_2_name {
local $_ = substr (shift, 8, 20) & ("\x7f") x 20;
s/^\d+//;
s/^[\x00-\x1f ]+//;
s/\s*[\x00-\x1f].*//;
s/\W?text.*//i;
$_;
}
sub find_key {
local $_ = shift;
return '.' if /3sat/;
return '1' if /ARD/;
return '2' if /ZDF/;
return '3' if /SW 3/;
return '7' if /PRO 7/;
return 'r' if /RTL Plus/;
return 't' if /RTL 2/;
return 'i' if /VIVA 2/;
return 'v' if /VIVA/;
return 'm' if /MTV/;
return 's' if /SAT 1/;
return 'k' if /Kabel 1/;
return 'e' if /EuroNews/;
return 'a' if /Arte/;
return 'x' if /VOX/;
();
}