Verwaltet TechniSat TechniStar S1 Receiver über Netzwerk

receiver_info.pl

#!/usr/bin/perl
# receiver_info.pl
# Verwaltet TechniSat TechniStar S1 Receiver über Netzwerk
# Copyright (c) 2011 Max Weller <perl AT max-weller.de>

use strict;
use LWP::UserAgent;

use Getopt::Std;

my $receiver_ip = "192.168.178.34";


my %options=();
getopts("hfs:c:a:", \%options);

$receiver_ip = $options{a} || $receiver_ip;

my $ua = LWP::UserAgent->new;


if (defined $options{f}) {

  my $lastSender = "";

  while (1) {
    my $response = $ua->get("http://$receiver_ip/main.html?_newremtimer=Neuer+Senderwechsel-Timer");
    my @lines = split "\n", $response->decoded_content;

    for(@lines) {
      if($_ =~ /<option selected value='[0-9]+'>(.*)<\/option>/) {
        last if ($_ eq $lastSender);
        print getcurtime(),"    Aktuelles Programm: ",$1,"\n";
        $lastSender = $_; last;
      }
    }
    sleep 5;
  }
  exit;
}

if (defined $options{s}) {
  my $response = $ua->get("http://$receiver_ip/main.html?_newremtimer=Neuer+Senderwechsel-Timer");
  my @lines = split "\n", $response->decoded_content;

  for(@lines) {
    if($_ =~ /<option(?: selected)? value='[0-9]+'>(.*$options{s}.*)<\/option>/i) {
      print $1,"\n";
    }
  }
  exit;
}

if (defined $options{c}) {
  my $start = getcurtime("%02d:%02d");
  print $start;
  
  
  my $response = $ua->post("http://$receiver_ip/main.html?_newremtimer=Neuer+Senderwechsel-Timer",
  Content => "service_1=".($options{c}-1) ."&date=".getcurdate()."&start=".$start."&stop=__:__&repeat=0&type=0&_set_newtimer=apply");
  
  my @lines = split "\n", $response->decoded_content;
  for(@lines) {
    print $_,"\n" if ($_ =~ /<h4>/);
  }
  print "Changed program\n";
  exit;
}

print "Usage:\n";
print "  perl $0 -h                print this help\n";
print "  perl $0 [-a IP] -f        follow program switching\n";
print "  perl $0 [-a IP] -s TERM   search program list for TERM\n";
print "  perl $0 [-a IP] -c ID     switch current program to ID\n";
print "         specify IP to change used receiver's Internet Protocol address\n";



sub getcurtime { my $format = shift || "%02d:%02d:%02d";
  my @td = localtime();
  return sprintf $format, $td[2], $td[1], $td[0];
}
sub getcurdate { my $format = shift || "%02d.%02d";
  my @td = localtime();
  return sprintf $format, $td[3], $td[4]+1, $td[5];
}