#!/usr/bin/perl

################################################################################
# Constants
################################################################################
sub true           () { 1 };
sub false          () { 0 };
sub CRLF           () { "\r\n" };

################################################################################
# Unpack active-state from timer
################################################################################
sub UnpackActive {
  my($tmstatus) = @_;
  # strip the first 16 bit
  return ($tmstatus & 0xFFFF);
}

################################################################################
# Unpack event_id from timer
################################################################################
sub UnpackEvent_id {
  my($tmstatus) = @_;
  # remove the lower 16 bit by shifting the value 16 bits to the right
  return $tmstatus >> 16;
}

################################################################################
# read timers for given provider
################################################################################
sub gettimers {
	my $prefix = shift;
	undef @oldtimers;
	#Timer holen
	# per SVDRP verbinden
	$SVDRP->command("lstt");
	while($_ = $SVDRP->readoneline) {
		doexit() if $please_exit;
		chomp;
		last if(/^No timers defined/);
		my($id, $temp) = split(/ /, $_, 2);
		my($tmstatus, $vdr_id, $dor, $start, $stop, $prio, $lft, $title, $summary) = split(/\:/, $temp, 9);
		my($active, $event_id);
		$active = UnpackActive($tmstatus);
		$event_id = UnpackEvent_id($tmstatus);
		if ($summary =~ /$prefix/) {
			push @oldtimers, $id;
		}
	}
	return (@oldtimers);
}

################################################################################
# delete timers
################################################################################
sub deltimers {
	my (@timers) = @_;
	foreach $timer (reverse @timers) {
		doexit() if $please_exit;
		my($result) = $SVDRP->SendCMD("delt $timer");
		}
}

################################################################################
# read channels.conf via svdrp into memory
################################################################################
sub getchan {
	undef(@chan);
	$SVDRP->command("lstc");
	while($_ = $SVDRP->readoneline) {
		doexit() if $please_exit;
		chomp;
		my($vdr_id, $temp) = split(/ /, $_, 2);	
		my($name, $frequency, $polarization, $source, $symbolrate, $vpid, $apid,
		  $tpid, $ca, $service_id, $nid, $tid, $rid) = split(/\:/, $temp);

		if ( $source eq 'T' ) { 
			$frequency=substr($frequency, 0, 3);
		}

		$data = $nid>0 ? $tid : $frequency;
		$rfc2838 = "";
		foreach $sender (keys(%chan)) {
			if ($chan{$sender}[0] eq "$source-$nid-$data-$service_id") {
			$rfc2838 = $sender;
			last;
			}	  
		}
		push(@chan, {
			vdr_id       => $vdr_id,
			name         => $name,
			frequency    => $frequency,
			polarization => $polarization,
			source       => $source,
			symbolrate   => $symbolrate,
			vpid         => $vpid,
			apid         => $apid,
			tpid         => $tpid,
			ca           => $ca,
			service_id   => $service_id,
			nid          => $nid,
			tid          => $tid,
			epg_id       => "$source-$nid-$data-$service_id",
			rid          => $rid,
			rfc2838      => $rfc2838
		}); 
	}
	return(@chan);
}

################################################################################
# read channels.conf into memory
################################################################################
sub ReadChannels {
	my $channelsfile = shift;
	# Now open the VDR channel file
	open(CHANNELS, "$channelsfile") || die "cannot open $channelsfile file: $!";
	while(<CHANNELS>) {

		doexit() if $please_exit;
		# Kategorien überspringen
		next if (/^:/);

		chomp;
		my($name, $frequency, $polarization, $source, $symbolrate, $vpid, $apid,
		$tpid, $ca, $service_id, $nid, $tid, $rid) = split(/\:/, $_);

		if ( $source eq 'T' || $source eq 'C' ) {
			if ( length($frequency) > 3) {
				$frequency=substr($frequency, 0, length($frequency)-3);
				}
			if ( length($frequency) > 3) {
				$frequency=substr($frequency, 0, length($frequency)-3);
				}
			}

		$data = $nid>0 ? $tid : $frequency;
		$rfc2838 = "";
		foreach $sender (keys(%chan)) {
			if ($chan{$sender}[0] eq "$source-$nid-$data-$service_id") {
			$rfc2838 = $sender;
			last;
			}	  
		}
		next if $rfc2838 eq "";
		# Channel ins Array aufnehmen
		push(@chan, {
			name         => $name,
			polarization => $polarization,
			source       => $source,
			symbolrate   => $symbolrate,
			vpid         => $vpid,
			apid         => $apid,
			tpid         => $tpid,
			ca           => $ca,
			service_id   => $service_id,
			nid          => $nid,
			tid          => $tid,
			rid          => $rid,
			epg_id		 => "$source-$nid-$data-$service_id",
			rfc2838      => $rfc2838
			}); 
	}
	return(@chan);
}

################################################################################
# get given URL either from web or cache
################################################################################
sub GetContent
{
	my $downloadurl = shift;
	my $cachefile = shift;
	my $post = shift;
	my $delay = shift;
	undef $html;
	my $html;
	my $tries = $networktries;
	my $success = 0;

#	print "get $cachefile || $downloadurl\n";
	eval 'use LWP::UserAgent';
	my $ua = new LWP::UserAgent; $ua->agent("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)");
	$ua->proxy('http', $http_proxy);
	$ua->timeout($timeout);
	if ($tvicache_files==1 && -s $cachefile ) {
		open(CACHE, "< $cachefile")  || warn "cannot read cachefile file: $!";
		while(<CACHE>) {
			$html .= $_;
		}
		close CACHE;
	} else {
		while ($tries > 0 && ! $success) {
			sleep 5 if $delay; # hoerzu macht dicht, wenns zu schnell geht ...
			$tries--;
			my $res;
			if($post) {
				my ($url, $data) = split(/\?/, $downloadurl, 2);
				my $req = HTTP::Request->new(POST => $url);
				$req->content_type('application/x-www-form-urlencoded');
				$req->content($data);
				$req->referer($url);
				$res = $ua->request($req);
			} else {
				my $req = new HTTP::Request(GET => $downloadurl);
				$res = $ua->request($req);
			}
			$success = 1 if $res->is_success;
			print "result: ", $res->status_line," \n" unless $success;
			doexit() if $please_exit;
			$html = $res->content;
			open(CACHE, "> $cachefile")  || warn "cannot write cachefile: $!";
			print CACHE $html;
			close CACHE;
		}
	if ($abortonnetwork && ! $success ) {
		print "cannot download file, aborting.\n";
		exit;
		}
	}

	$loglength = length($html);
	$loggeslength = $loggeslength + $loglength;
	open(LOG, ">> download.log") || die "cannot write to download.log file: $!";
	print LOG "$loggeslength\t\t$loglength\t$downloadurl\n";
	close LOG;


	return $html;
}

sub SIGhandler {    
	my($sig) = @_;
	$please_exit=1;
}

sub doexit {
	print "exiting ... \n";
	$SVDRP->close;
	exit;
}

sub cleanup {
	$yesterday = UnixDate($gestern, "%Y%m%d");
	$today = UnixDate($heute, "%Y%m%d");

	opendir DH, $downloadprefix ;
	@directory = readdir DH ;
	close DH ;
	foreach $file (@directory) {	
		# Älter als einen Tag? weg damit.
		if ($file =~ m/$yesterday/) {
			unlink("$downloadprefix$file");
		}
	}

	opendir DH, $updateprefix ;
	@directory = readdir DH ;
	close DH ;
	foreach $file (@directory) {	
		# Älter als einen Tag? weg damit.
		if ($file =~ m/$yesterday/) {
			unlink("$updateprefix$file");
		}
	}

if ($useupdate) {
	print "lösche Daten von heute ..\n";
	opendir DH, $downloadprefix ;
	@directory = readdir DH ;
	close DH ;
	foreach $file (@directory) {	
		# Daten von heute? download forcieren.
		# TVMovie-Daten nicht loeschen, dafuer gibt es
		# updatefiles.
		next if $file =~ m/^tvmovie_/;
		if ($file =~ m/$today/) {
			unlink("$downloadprefix$file");
		}
	}
}

}

sub makeEPGevent {
# unpacking and packing for utf8-stuff
#
my $event_id = pack "U0C*", unpack "C*", shift;
my $start = pack "U0C*", unpack "C*", shift;
my $dauer = pack "U0C*", unpack "C*", shift;
my $title = pack "U0C*", unpack "C*", shift;
my $subtitle = pack "U0C*", unpack "C*", shift;
my $id = pack "U0C*", unpack "C*", shift;
my $mode = pack "U0C*", unpack "C*", shift;
my $summary = pack "U0C*", unpack "C*", shift;

my $regie = pack "U0C*", unpack "C*", shift;
my $darsteller = pack "U0C*", unpack "C*", shift;
my $genre =  pack "U0C*", unpack "C*", shift;
my $kategory = pack "U0C*", unpack "C*", shift;
my $country = pack "U0C*", unpack "C*", shift;
my $year = pack "U0C*", unpack "C*", shift;
my $audio = pack "U0C*", unpack "C*", shift;
my $format = pack "U0C*", unpack "C*", shift;
my $flags = pack "U0C*", unpack "C*", shift;
my $origtitle = pack "U0C*", unpack "C*", shift;
my $fsk = pack "U0C*", unpack "C*", shift;
my $folge = pack "U0C*", unpack "C*", shift;
my $bewertung = pack "U0C*", unpack "C*", shift;
my $channel = pack "U0C*", unpack "C*", shift;
my $shortsummary = pack "U0C*", unpack "C*", shift;
my $wertung = pack "U0C*", unpack "C*", shift;

my $epgsummary = "";
use bytes;
$epgsummary = "$kategory/$genre"		if $wanttopflags && ($kategory || $genre);
$epgsummary =~ s/^\///				if $wanttopflags;
$epgsummary =~ s/\/$//				if $wanttopflags;
$epgsummary .= ", $country" 			if $country && $wanttopflags;
$epgsummary .= ", $year" 			if $year && $wanttopflags;
$epgsummary .= ", FSK: $fsk" 			if $fsk && $wanttopflags;
$epgsummary .="|"				if $wanttopflags;
$epgsummary .= " ($origtitle) "			if $origtitle && $wanttopflags;
$epgsummary .= " $flags " 			if $flags && $wanttopflags;
$epgsummary .= "|"				if $epgsummary;

$epgsummary .= "|$shortsummary|"		if $shortsummary;
$epgsummary .= "|$wertung|"			if $wertung;
$epgsummary .= "|$summary|" 			if $summary;
$epgsummary .= "|Director: $regie "		if $regie;
$epgsummary .= "|Cast: $darsteller"		if $darsteller;
$epgsummary .= "|Category: $kategory" 		if $kategory && $wantbottomflags;
$epgsummary .= "|Genre: $genre" 		if $genre && $wantbottomflags;
$epgsummary .= "|Year: $year" 			if $year && $wantbottomflags;
$epgsummary .= "|Country: $country" 		if $country && $wantbottomflags;
$epgsummary .= "|Originaltitle: $origtitle" 	if $origtitle && $wantbottomflags;
$epgsummary .= "|Audio: $audio" 		if $audio && $wantbottomflags;
$epgsummary .= "|Format: $format"		if $format && $wantbottomflags;
$epgsummary .= "|FSK: $fsk" 			if $fsk && $wantbottomflags;
$epgsummary .= "|Episode: $folge" 		if $folge && $wantbottomflags;
$epgsummary .= "|Rating: $bewertung" 		if $bewertung && $wantbottomflags;
$epgsummary .= "|";
$epgsummary =~ s|^, ||;

# remove HTML chars
$epgsummary=xmltvtranslate($epgsummary);
$title=xmltvtranslate($title);
$subtitle=xmltvtranslate($subtitle);

if ($mode eq "original") {
#	print "inserting $event_id $start $dauer $channel $title .. $kategory/$genre .. $wertung/$bewertung \n";
#	print "$epgsummary\n";
	push(@events, {
		start        => $start, 
		stop         => $start + $dauer, 
		duration     => $dauer,
		title        => $title, 
		subtitle     => $subtitle, 
		summary      => $epgsummary, 
		id           => $id,    
		event_id     => $event_id,
		state        => 1, # normale Sendung
		channel      => $channel
		});
} else {
	$updatefound = 0;
	for ($i=0; $i<=$#{$XML{$sender}};$i++) {
		if (@{$XML{$sender}}[$i]->{event_id} eq $event_id) {
			print "updating $start $title $event_id\n";
			$updatefound = 1;
			@{$XML{$sender}}[$i]->{start}        = $start;
			@{$XML{$sender}}[$i]->{stop}         = $start + $dauer;
			@{$XML{$sender}}[$i]->{duration}     = $dauer;
			@{$XML{$sender}}[$i]->{title}        = "$marktvmupdate" . "$title"; 
			@{$XML{$sender}}[$i]->{subtitle}     = $subtitle;
			@{$XML{$sender}}[$i]->{summary}      = $epgsummary; 
			@{$XML{$sender}}[$i]->{state}        = 2; # aktualisierte Sendung
		} # if
	} # for
	if ($updatefound eq 0) {
		print "inserting new $start $title $event_id\n";
		push(@events, {
			start        => $start, 
			stop         => $start + $dauer, 
			duration     => $dauer,
			title        => "$marktvmupdate" . "$title", 
			subtitle     => $subtitle, 
			summary      => $epgsummary, 
			id           => $id,    
			event_id     => $event_id,
			state        => 2 # aktualisierte Sendung
			});
	}
} # else
no bytes;
}


# Translate HTML/XML encodings into normal characters
# For some German problems, and also English

sub xmltvtranslate
{
  my $line=shift;
  use bytes;

  $line=~s/&amp;/&/g;
  $line=~s/&mdash;/--/g;
  $line=~s/&lsquo;/'/g;
  $line=~s/&euro;/EUR/g;
  $line=~s/&deg;/°/g;
  $line=~s/&ordm;/º/g;
  $line=~s/&iacute;/í/g;
  $line=~s/&hellip;/.../g;
  $line=~s/&uuml;/ü/g;
  $line=~s/&auml;/ä/g; 
  $line=~s/&ouml;/ö/g;
  $line=~s/&quot;/"/g; 
  $line=~s/&szlig;/ß/g; 
  $line=~s/&amp;/\&/g; 
  $line=~s/&middot;/·/g; 
  $line=~s/&Ouml;/Ö/g; 
  $line=~s/&Auml;/Ä/g;
  $line=~s/&Uuml;/Ü/g ;
  $line=~s/&eacute;/é/g;
  $line=~s/&aacute;/á/g;
  $line=~s/&deg;/°/g;
  $line=~s/&ordm;/º/g;
  $line=~s/&ecirc;/ê/g;
  $line=~s/&ecirc;/ê/g;
  $line=~s/&ccedil;/ç/g;
  $line=~s/&curren;/¤/g;
  $line=~s/&curren;/¤/g;
  $line=~s/&Ccedil;/Ç/g;
  $line=~s/&ocirc;/ô/g;
  $line=~s/&egrave;/è/g;
  $line=~s/&agrave;/à/g;
  $line=~s/&quot;/"/g;
  $line=~s/&Ouml;/Ö/g;
  $line=~s/&Uuml;/Ü/g;
  $line=~s/&Auml;/Ä/g;
  $line=~s/&ouml;/ö/g;
  $line=~s/&uuml;/ü/g;
  $line=~s/&auml;/ä/g;
  $line=~s/&lt;/</g;
  $line=~s/&gt;/>/g;
  $line=~s/&ndash;/-/g;
  $line=~s/&bdquo;/"/g;
  $line=~s/&ldquo;/"/g;
  $line=~s/&rsquo;/'/g;
  $line=~s/&nbsp;/ /g;
  $line=~s/<br>/|/ig;
  no bytes; 
  return $line;
}


sub printHumantime {
my $utime = shift;
my $time = UnixDate(&ParseDateString("epoch $utime"),"%H:%M:%S %d.%m.%Y");
return $time;
}

sub singlesvdrp {
my $svdrpline = shift;
my $SVDRP = SVDRP->new($Dest,$Port,$verbose,$sim) unless $novdr;
my $return = $SVDRP->SendCMD($svdrpline);
$SVDRP->close;
return $return;
}


###############################################################################
#
# package SVDRP
#
package SVDRP;

sub true       () { main::true(); }
sub false      () { main::false(); };
sub CRLF       () { main::CRLF(); };

my($SOCKET, $EPGSOCKET, $query, $connected, $epg);

sub new {
	my $invocant = shift;
	$Dest = shift;
	$Port = shift;
	$verbose = shift;
	$sim = shift;
	my $class = ref($invocant) || $invocant;
	my $self = { };
	bless($self, $class);
	$connected = false;
	$query = false;
	$epg = false;
	return $self;
}

sub myconnect {
	my $this = shift;

	if ($sim == 0) {
		$SOCKET = IO::Socket::INET->new(
			PeerAddr => $Dest, 
			PeerPort => $Port, 
			Proto => 'tcp'
		) || die;

		my $line;
		$line = <$SOCKET>;
		$connected = true;
	}
}

sub close {
	my $this = shift;
	if($connected) {
		command($this, "quit");
		readoneline($this);
		close $SOCKET if $SOCKET;
		$connected = false;
	}
}

sub command {
	my $this = shift;
	my $cmd = join("", @_);

	if ($verbose == 1) {
		print "$cmd\n";
	}

	if ($sim == 1) {
		return;
	}

	if(!$connected ) {
		myconnect($this);
	}
	
	$cmd = $cmd . CRLF;
	if($SOCKET) {
		use bytes;
		my $result = send($SOCKET, $cmd, 0);
		if($result != length($cmd)) {
		} else {
			$query = true;
		}
		no bytes;
	}
}

sub readoneline {
	my $this = shift;
	my $line;

	if ($sim == 1) {
		return undef;
	}

	if($connected && $query) {
		$line = <$SOCKET>;
		$line =~ s/\r\n$//;
		if(substr($line, 3, 1) ne "-") {
			$query = 0;
		}
		$line = substr($line, 4, length($line));

		if ($verbose == 1) {
			print "< $line\n";
		}

		return($line);
	} else { 
		return undef; 
	}
}

sub SendCMD {
	my $this = shift;
	my $cmd = join("", @_); 
	my @output;

	if ($sim == 1) {
		print "$cmd \n";
		return (@output);
	}

	command($this, $cmd);
	while($_ = readoneline($this)) {
		push(@output, $_);
	}
  return(@output);
}

return 1;
