#!/usr/bin/perl -w

#    records internet radio streams for a given duration, restarts on lost streams
#    Copyright (C) 2005  Karl-Heinz Herrmann

#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.

#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.

#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.


use WWW::Mechanize;
use POSIX;

if (@ARGV != 2){
  print "wrong arguments\n";
  print "Usage:\n";
  print "  getradio.pl [br2|br4|wdr3|wdr5|dlr|einslive|figaro] duration\n";
  exit;
}

$sender=shift  @ARGV;
$duration=shift @ARGV;

print "recording $sender for $duration min.\n";

if ($sender eq "dlrmms"){

  my $mech = WWW::Mechanize->new();
  
  $mech->get( "http://www.dradio.de/streaming/dkultur.asx" );
  
  $file= $mech->content();
  
  $file =~ /href="(http.*\.asx)"/;
  
  print "asx file: $1\n";
  
  $mech->get($1);
  
  $asx=$mech->content();
  
  $asx =~ /href\s*=\s*"(mms.*?)"/s;
  print "found the mms-link:\n $1\n";
  $link1=$1;

}elsif($sender eq "dlr"){
  print "don't mess around for ogg dlr, just use standard link\n";
  $link1="http://dradio-ogg.t-bn.de/dkultur_high.ogg";

}elsif($sender eq "dlf"){
  print "don't mess around for ogg dlr, just use standard link\n";
  $link1="http://dradio-live.ogg.t-bn.de/dlf_high.ogg";

}elsif($sender eq "br4"){
  print "recording $sender for $duration min.\n";
  
  my $mech = WWW::Mechanize->new();
  
  $mech->get( "http://www.br-online.de/streaming/bayern4klassik/bayern4klassik_red.asx" );
  
  $file= $mech->content();
  
  $file =~ /href="(mms:.*)"/;
  
  print "found the mms-link:\n $1\n";
  $link1=$1;
}
elsif($sender eq "br2"){
  print "recording $sender for $duration min.\n";
  
  my $mech = WWW::Mechanize->new();
  
  $mech->get( "http://streams.br-online.de/bayern2_2.asx" );
  
  $file= $mech->content();
  
  $file =~ /href="(mms:.*)"/;
  
  print "found the mms-link:\n $1\n";
  $link1=$1;
}elsif($sender eq "figaro"){
  print "recording $sender for $duration min.\n";
  
  my $mech = WWW::Mechanize->new();
  
  $mech->get( "http://mdr.streamfarm.net/cms/_vm100/radios/mdr/live/figaro_cms.asx" );
  
  $file= $mech->content();
  
  $file =~ /href="(mms:.*)"/;
  
  print "found the mms-link:\n $1\n";
  $link1=$1;
}else{

  my $mech = WWW::Mechanize->new();
  
  $mech->get( "http://www.wdr.de/wdrlive/radio.phtml?channel=$sender" );
  
  $mech->submit_form(
		     form_number => 1,
		     fields      => {
				     radio_stream    => '32'
				    }
		    );
  
  $file= $mech->content();
  
  $file =~ /src="media\/(.*\.asx)/;
  
  #print "asx file: $1\n";
  
  $mech->get( "http://www.wdr.de/wdrlive/media/$1");
  
  $asx=$mech->content();
  
  $asx =~ /href="(mms.*?)".*href="(mms.*)"/s;
  print "found the two mms-links:\n $1\n $2\n";
  $link1=$1;
  #$link2=$2;
  
}  


# ok so here we know everything to start the recording

# new idea: fork and disinherit terminal to decouple everything
# from STDIN
# That will cause atd getting no output anymore -> logfile? 
# THEN fork the recorder
# program an alarm in main 
# stop main in a blocking waitpid and set SIGALRM handler
# if waitpid returns unexpectedly restart recording

# to kill the whole program group I need the program group number
# -- which seems to coincide with the PID of the very first process.
# lets call its grandparent

$grandparent=$$;

die "can't fork: $!" unless defined($daemonizepid = fork());

if ($daemonizepid){
  print "grandparent: $grandparent: this is  PID $$  (just forked pid $daemonizepid)\n -- now exiting to disown the child\n";
  exit 0;
}


# this is the disowned process -- mplayer should be save from keyboard
# input and atd

# start new session ID -- than this should be new Program group ID (PGID) to kill later

$SID=POSIX::setsid()
    or die "Can't start a new session: $!";

print "starting new session $SID\n";

die "can't fork: $!" unless defined($kidpid = fork());

if ($kidpid){ 
  
  print "forked: started recorder pid $kidpid\n";
  
  # this is parent thread

  local $SIG{ALRM} = \&timed_out;
  alarm($duration*60+10);

  waitpid($kidpid,0);   # just to block parent till alarm goes off
  # $buf=<>; is not good -- return from atd would trigger that.
  # no idea why we still get STDIN for this process. (Grand)Parent disowned us to init already
  print "parent ($$) -- child $kidpid came back.\n";
  $left=alarm(0);
  print "alarm had $left time left!\nexiting anyway...\n";
  
}else{
  
  # child process
  # here we run mplayer to record the stuff to a wav file


  $part="-0";
  $pn=1;
  $date=`date +"%Y%m%d-%R"`;
  $date=~s/:/_/g;
  chomp($date);

  if ($sender eq "dlr" || $sender eq "dlf"){
    # ok -- this is wget stuff
    while (1){
      system("wget",$link1,"-O",$sender."-".$date.$part.".ogg","-nv","-t","500");
      waitpid($kidpid,0);
      print "recording process came back. restarting\n";
      $part="-".$pn++;
    }
  }else{
    
    
    while (1){
      # paranoia -- there shouldn't be two recordings of the same stuff 
      # so thenames should be unique -- but nevertheless at least try to keep two 
      # processes overwriting each other. (should be a while checking till a nonexisitng file is generated)
      if ( -f $sender."-".$date.$part.".wav" ){
	print "looks like the outputfile exists already....\n";
	$date=$date."-a";
      }
      system ('mplayer',$link1, "-vc", "dummy", "-vo", "null", "-ao", "pcm:waveheader:file=$sender-".$date.$part.".wav");
      waitpid($kidpid,0);
      print "recording process came back. restarting\n";
      $part="-".$pn++;
    }
  }
}

print "program reached code after all the forking code....shouldn't happen.\nkilling myself and all my children.\n";
 kill("TERM" => -$$);


sub timed_out{
  # so recording is finished
#  kill ("TERM" => $kidpid);
  kill("TERM" => -$$);
  kill("TERM" => -$SID);
  kill("TERM" => -$grandparent);
  die "recording finished\n";
}