#!/usr/bin/perl -w

# A wrapper for dsproxy, realplayer and lame
# Homepage: http://scara.com/strec/
# 
# Copyright (c) 1995 by Christian Wolff (scarabaeus.org)
# Released under the GPL, see http://www.gnu.org/copyleft/gpl.html
# 
# What you'll need:
# DSProxy:    http://scara.com/dsproxy/
# RealPlayer: http://www.real.com/ 
#  (old ver.: http://forms.real.com/real/player/blackjack.html)
#  (current version of dsproxy still has problems with rp10, use rp8 instead)
# Lame:       http://lame.sourceforge.net/
# gnu wget:   http://wget.sunsite.dk/
# LibID3v2    http://id3lib.sourceforge.net/
# id3v2       http://id3v2.sourceforge.net/
# openRTSP    http://www.live.com/liveMedia/
#   (compile, then copy 'live' directory to /usr/local/ or change $openRTSP below)
# 
# How to do it:
# - Make sure all the software above is installed
# - Start with "strec.pl <file or URL> [<perfect>]"
#   - URL can be any http:, rtsp: or pnm: link
#     - The recording file name will be that of the .rm file, 
#       e.g. rtsp://server.com/dir/file.rm --> file.mp3
#   - file can be:
#     - filename.url: One line with a URL as above
#     - filename.strec: First line with the URL, second line with Title, Artist, Album and Year, separated by TABs.
#     - Otherwise, a line with 'rtsp:' from the file will be used as the URL
#     - The recording filename will be that of the file, 
#       e.g. /tmp/file.ram --> /tmp/file.mp3 (or $target/file.mp3, if $target is set below)
# - If you specify a non-zero value for <perfect>, the recoding will be
#   stopped if a DSP_RESET Alert is encountered.
# - Now the realplayer should start and you should see some messages like these:
#   00:00:00.00 SNDCTL_DSP_RESET
#   00:00:00.00 SNDCTL_DSP_SPEED    => 44100
#   00:00:00.00 SNDCTL_DSP_CHANNELS => 2
#   Assuming raw pcm input file : Forcing byte-swapping
#   LAME version 3.93  (http://www.mp3dev.org/)
#   Using polyphase lowpass  filter, transition band: 15115 Hz - 15648 Hz
#   Encoding <stdin> to audiofile.mp3
#   Encoding as 44.1 kHz 128 kbps j-stereo MPEG-1 Layer III (11x) qval=2
#   00:00:00.00 SNDCTL_DSP_SETFMT   => AFMT_S16_LE AFMT_S16_NE
#   00:00:00.00 SNDCTL_DSP_RESET
#   00:00:00.00 SNDCTL_DSP_SETFRAGMENT => 0001000d
#   00:00:00.00 SNDCTL_DSP_SETFMT   => AFMT_S16_LE AFMT_S16_NE
#   00:00:00.00 SNDCTL_DSP_CHANNELS => 2
#   00:00:00.00 SNDCTL_DSP_SPEED    => 44100
#   00:00:00.00 SNDCTL_DSP_RESET
#   
#   waiting 5
# - The "waiting" value will count up until the pre-buffering is finished, 
#   after that is continues like this:
#   00:00:00.00 SOUND_MIXER_WRITE_VOLUME => 75 - 75
#   00:00:00.00 SOUND_MIXER_WRITE_BASS   => 75 - 75
#   00:00:00.00 SOUND_MIXER_WRITE_TREBLE => 75 - 75
#   00:00:00.00 SOUND_MIXER_WRITE_PCM    => 75 - 75
#   00:00:00.00 SOUND_MIXER_WRITE_PCM    => 75 - 75
#   00:05:23.42 
# - The time value at the bottom will keep on going during the recording.
# - After the file has finished playing, you should see two more
#   DSP_RESET messages and success message like:
#     "FINISHED: clip is completed at 00:00:10.52"
#   The printed time is the recorded length of the .mp3 file. 
# - If there were any other DSP_RESET messages during the file recording, 
#   the connection got bad and you might have to start over again.
#   If that happens, a warning is also displayed: 
#     "ALERT! stream interruption at 00:00:05.70"
#
# v1.0 - 2005-05-01
# v1.1 - 2005-05-02
#

use strict;
use IPC::Open3;
use IO::Select;


# global parameter
my $debug = 0;  # whether to print debug messages
my $target = '';   # where to write the mp3 files

# applications
my $wget = 'wget -q -O -';  # read file via http to stdout
my $openRTSP = '/usr/local/live/testProgs/openRTSP -t -s 0';  # download rtsp link
my $dsproxy = 'dsproxy_reader -e -x -s';
my $encoder = 'lame';
my $player = 'realplay';



$| = 1;

my ($pid, $rec_pid, $dsp_pid, $play_pid) = (0, 0, 0, 0);
my $perfect = 0;
my $multipart = 0;
my $exitcode = 0;
my $inact_max = 30;  # inactivity timeout, in seconds

sub get_running_time($)
{
	my $rtsp = shift;
	my $runtime = 0;
	chomp $rtsp;
	open RUNTIME, "(mkdir -p /tmp/rtsp$$~ ; cd /tmp/rtsp$$~ ; ${openRTSP} ${rtsp}) 2>&1 |" or return 0;
	while (<RUNTIME>) {
		$runtime = $1 if ($_=~/^a\=EndTime\:integer\;(\d+)/);
	}
	close RUNTIME;
	`rm -rf /tmp/rtsp$$~`;
	return $runtime;
}

sub get_title($)
{
	my $rtsp = shift;
	my $title = '';
	chomp $rtsp;
	open RUNTIME, "(mkdir -p /tmp/rtsp$$~ ; cd /tmp/rtsp$$~ ; ${openRTSP} ${rtsp}) 2>&1 |" or return 0;
	while (<RUNTIME>) {
		$title = $1 if ($_=~/^s=(.*)\r/);
	}
	close RUNTIME;
	`rm -rf /tmp/rtsp$$~`;
	return $title;
}

sub get_live_title($)
{
	my $rtsp = shift;
	my $live = 0;
	my $title = '';
	my $dir = "/tmp/rtsp_live$$~";
	chomp $rtsp;
	open RTSP, "(mkdir -p ${dir} ; cd ${dir} ; ${openRTSP} ${rtsp}) 2>&1 |" or return '';
	while (<RTSP>) {
		$live = $1 if ($_=~/^a\=LiveStream\:integer\;(\d+)/);
		$title = $1 if ($_=~/^s=(.*)\r/);
	}
	close RTSP;
	`rm -rf ${dir}`;
	return $live ? ($title ? $title : 'Live') : '';
}

sub get_rtsp_from_ram($)
{
	my $ram = shift;
	my $rtsp = '';
	open RAM, "${wget} ${ram} |" or return $ram;
	while (<RAM>) {
		unless ($rtsp =~ /rtsp:/) {  # prefer rtsp, 
			$rtsp = $_ if /^\w+:/ and !/Usage/;       # but take any qualified link (pnm: etc.)
		}
	}
	close RAM;
	$rtsp = $ram unless ($rtsp);
	chomp $rtsp;
	return $rtsp;
}

sub get_rm_from_smil($)
{
	my $rtsp = shift;
	my $rm = '';
	my $dir = '/tmp/rtsp' . $$ . '~';
	`(mkdir -p ${dir} ; cd ${dir} ; ${openRTSP} ${rtsp}) > /dev/null 2>&1`;
	if (open SMIL, "${dir}/application-VND.RN-RMADRIVER-1" or open SMIL, "/tmp/rtsp$$~/application-SMIL-1") {
		while (<SMIL>) {
			s/\"\).*\(doc \"//;
			if ((!/logo/) and (!/feedback/) and /src=\\"(.*\.rm)\\"/) {
				my $smil = $1 . "\n";
				$rm .= $smil;
			}
		}
		close SMIL;
		$rm = $rtsp unless ($rm);
	} else {
		print STDERR "ERROR: can't open smil file in ${dir}, error $?: $!\n" if $debug;
		$rm = $rtsp;
	}
	`rm -rf ${dir}`;
	return $rm;
}

sub play
{
	my $url = shift;
	
	print STDERR " # parent: Player --> ${player} '${url}'\n" if $debug;
	$play_pid = open PLAY, "${player} '${url}' 2>&1 |" or die "Can't start Player\n";
	while (<PLAY>) {};
	if ($?) {
		my ($err, $sig, $core) = ($? >> 8, $? & 0x7F, ($? & 0x80) >> 7);
		print STDERR "\n # parent: Player failed - error ${err}, signal ${sig}, core ${core}\n" if $debug;
		system ("killall ${player}");  # kill orphaned spawns
	}
}

# record(filename, title, artist, album, year)
#  filename has to be without .mp3 extension
sub record
{
	my ($filename, $title, $artist, $album, $year) = @_;
	
	my ($line, $time, $cmd, $param);
	my ($speed, $channels, $fmt) = (0, 0, '');
	my ($ns, $nc, $nf) = ($speed, $channels, $fmt);
	my $sequence = 0;
	my $run = 1;
	
	$rec_pid = 0;
	print STDERR " # child: Capture --> ${dsproxy}\n" if $debug;
	$dsp_pid = open3(\*WR,\*RD,\*ERR, "${dsproxy}");
	unless ($dsp_pid) {
		print STDERR " # child: Cannot open Capture! $!\n" if $debug;
		$exitcode = 2;
		return;
	}
	
	my $timeout;
	my $stderr = '';
	my ($dsp_reset, $dsp_last) = ('', '00:00:00.00');
	my $dsp_s = IO::Select->new();
	$dsp_s->add(\*ERR);
	$dsp_s->add(\*RD);
	while ($run) {
		my @ready = $dsp_s->can_read(1);
		$timeout++;
		foreach (@ready) {
			my ($rc, $result);
			$timeout = 0;
			$rc = sysread($_, $result, 1024);
			if ($_ == \*ERR) {  # $result is from stderr
				print STDERR $result;
				$stderr .= $result;
				while (($line, $stderr) = split /[\r\n]/, $stderr, 2) {
					if ($line =~ /^(\d{2}\:\d{2}\:\d{2}\.\d{2}) ?(\w*)(.*)/) {
						($time, $cmd, $param) = ($1, $2, $3);
						$param = $1 if $param =~ /=> (.*)$/;
						$ns = $param if $cmd =~ /^SNDCTL_DSP_SPEED$/;
						$nc = $param if $cmd =~ /^SNDCTL_DSP_CHANNELS$/;
						$nf = $param if $cmd =~ /^SNDCTL_DSP_SETFMT$/;
						if (($cmd =~ /^SNDCTL_DSP_/) && ($cmd !~ /^SNDCTL_DSP_RESET$/)) {
							$dsp_last = $time;
							$dsp_reset= '' if ($dsp_reset eq $time);
						}
						if ($dsp_reset && ($dsp_reset ne $time)) {
							print STDERR "ALERT! stream interruption at ${dsp_reset}\n";
							$dsp_reset = '';
							$exitcode = 1;
							$run = 0 if $perfect;
						}
						if (($cmd =~ /^SNDCTL_DSP_RESET$/) && ($time ne $dsp_last)) {
							if ($dsp_reset eq $time) {
								print "FINISHED: clip is completed at ${dsp_reset}\n";
								$dsp_reset = '';
								$run = 0 unless $multipart;
							} else {
								$dsp_reset = $time;
							}
						}
					}
				}
				# sample frequency or number of channels has changed, start new recoder
				if (($speed != $ns) || ($channels != $nc)) {
					$speed = $ns if ($speed != $ns);
					$channels = $nc if ($channels != $nc);
					if ($speed && $channels) {
						if ($rec_pid) {
							close REC;
							print STDERR " # child: waiting for Encoder pid $rec_pid\n" if $debug;
							waitpid($rec_pid, 0);
							$sequence++;
						}
						my $recname = $filename . ($sequence ? "_${sequence}" : '') . '.mp3';
						my $bitrate = 
							($channels == 1) ? 
								(($speed > 22050) ? 96 : 64) 
							: 
								(($speed > 22050) ? 128 : 96);
						my $options = '-r -x -h';  # raw pcm, reverse byte order, high quality
						$options .= ' -s ' . $speed / 1000;  # pcm sample rate, in kHz
						$options .= ' -m ' . (($channels == 1) ? 'm' : 'j');  # mono / joint stereo
						$options .= ' -b ' . $bitrate;
						$options .= " --add-id3v2 --tt \'${title}\' --ta \'${artist}\' --tl \'${album}\' --ty ${year}";
						print STDERR " # child: Encoder --> ${encoder} ${options} - ${recname}\n" if $debug;
						$rec_pid = open(REC, "| ${encoder} ${options} - ${recname}");
						unless ($rec_pid) {
							print STDERR " # child: failed to start Encoder! $!\n" if $debug;
							$exitcode = 2;
							return;
						}
					}
				}
			} else {  # $result is from stdout
				print REC $result if $rec_pid;  # pipe to Encoder
			}
		}
		print STDERR "\n" if $timeout == 1;
		print STDERR "waiting ${timeout}/${inact_max}\r" if $timeout;
		last if ($timeout >= $inact_max);
	}
	print STDERR "\n";
	kill_rec();
	kill_dsp();
}

sub kill_rec
{
	print STDERR " # child: killing Encoder\n" if $debug;
	if ($rec_pid) {
		close REC;
		kill 'HUP', $rec_pid;
		print STDERR " # child: waiting for pid $rec_pid\n" if $debug;
		waitpid($rec_pid, 0);
		if ($? & 0xFFFF) {
			my ($err, $sig, $core) = (($? >> 8) & 0xFF, $? & 0x7F, ($? & 0x80) >> 7);
			print STDERR " # child: Encoder failed - error ${err}, signal ${sig}, core ${core}\n" if $debug;
		}
	} else {
		print STDERR " # child: Encoder already killed\n" if $debug;
	}
}

sub kill_dsp
{
	print STDERR " # child: killing Capture\n" if $debug;
	if ($dsp_pid) {
		close WR;
		close RD;
		close ERR;
		kill 'HUP', $dsp_pid;
		print STDERR " # child: waiting for pid $dsp_pid\n" if $debug;
		waitpid($dsp_pid, 0);
		if ($? & 0xFFFF) {
			my ($err, $sig, $core) = (($? >> 8) & 0xFF, $? & 0x7F, ($? & 0x80) >> 7);
			print STDERR " # child: Capture failed - error ${err}, signal ${sig}, core ${core}\n" if $debug;
		}
	} else {
		print STDERR " # child: Capture already killed\n" if $debug;
	}
}

sub sighup_child
{
	my $signame = shift;
	print STDERR "\n # child: Received SIG${signame}\n" if $debug;
	kill_rec();
	kill_dsp();
	print STDERR " # child: Exiting with code ${exitcode}\n" if $debug;
	exit $exitcode;
}

sub sighup_parent
{
	my $signame = shift;
	print STDERR "\n # parent: Received SIG${signame}, killing Player\n" if $debug;
	if ($play_pid) {
		kill $signame, $play_pid;
		print STDERR " # parent: waiting for pid $play_pid\n" if $debug;
		waitpid($play_pid, 0);
		if ($? & 0xFFFF) {
			my ($err, $sig, $core) = (($? >> 8) & 0xFF, $? & 0x7F, ($? & 0x80) >> 7);
			print STDERR " # parent: Player failed - error ${err}, signal ${sig}, core ${core}\n" if $debug;
			system ("killall ${player}");  # kill orphaned spawns
		}
	} else {
		print STDERR " # parent: Player already killed\n" if $debug;
	}
}


# main

my ($url, $name, $filename, $title, $artist, $album, $releaseyear);

print "strec - a Stream Recorder, (c) 2005 Christian Wolff\n";

$url = shift;
$perfect = shift;

$name = $url;
if ($url =~ /^\w+\:(.*)$/) {  # URL
	$name = $1;
	$name = $1 if $name =~ /^.*\/(.*?)\..*$/;
} else {  # file
	$name = $1 if $url =~ /^(.*?)\.\w*$/;
	open FILE, "$url" or die "can't open file ${url}!\n";
	if ($url =~ /\.url$/) {
		$url = <FILE>;
		chomp $url;
	} elsif ($url =~ /\.strec$/) {
		my $path = '';
		$path = $1 if $url =~ /^(.*\/)/;
		$url = <FILE>;
		chomp $url;
		my $desig = <FILE>;
		chomp $desig;
		($title, $artist, $album, $releaseyear) = split /\t/, $desig;
		if ($url =~ /^\/.*\.ram/) {  # see if .ram file is in same dir as .strec file
			$url =~ s/^.*\//$path/ unless -e $url;
			if (open RAM, $url) {
				my $rm = '';
				while (<RAM>) {
					$rm .= $_ if ~/rtsp:/;
				}
				$multipart = 1 if ($rm =~ /\n.*\n/s);
				close RAM;
			}
		}
	} else {
		my $rm = '';
		while (<FILE>) {
			$rm .= $_ if ~/rtsp:/;
		}
		if ($rm =~ /\n.*\n/s) {  # multiple rm links, create local .ram in /tmp
			if (open RAM, ">/tmp/strec_$$.ram") {
				print RAM $rm;
				close RAM;
				$url = "/tmp/strec_$$.ram";
				$multipart = 1;
			}
		} else {
			$url = $rm;
			chomp $url;
		}
	}
	close FILE;
}

print STDERR "URL[0]: ${url}\n" if $debug;
my $orl = $url;
$url = get_rtsp_from_ram($url) if $url =~ /^http:/;
print STDERR "URL[1]: ${url}\n" if ($debug && ($url ne $orl));
if ($url =~ /\.smil$/) {
	$orl = $url;
	my $rm = get_rm_from_smil($url);
	if ($rm =~ /\n.*\n/s) {  # multiple rm links, create local .ram in /tmp
		if (open RAM, "/tmp/strec_$$.ram") {
			print RAM $rm;
			close RAM;
			$url = "/tmp/strec_$$.ram";
			$multipart = 1;
		}
	} else {
		$url = $rm;
		chomp $url;
	}
	print STDERR "URL[2]: ${url}\n" if ($debug && ($url ne $orl));
}
$multipart = 1 if ($url =~ /\.smil$/);

FORK: {
	if ($pid = fork) {
		$SIG{'HUP'} = \&sighup_parent;
		
		print STDERR " # parent: waiting for child\n" if $debug;
		sleep 2;
		
		print STDERR " # parent: start Player $url\n" if $debug;
		play($url);
		
		print STDERR "\n # parent: killing child\n" if $debug;
		kill 'HUP', $pid;
		print STDERR " # parent: waiting for pid $pid\n" if $debug;
		waitpid($pid, 0);
		if ($? & 0xFFFF) {
			my ($err, $sig, $core) = (($? >> 8) & 0xFF, $? & 0x7F, ($? & 0x80) >> 7);
			print STDERR " # parent: child failed - error ${err}, signal ${sig}, core ${core}\n" if $debug;
			$exitcode = $err unless $exitcode;
		}
	} elsif (defined $pid) {
		$SIG{'HUP'} = \&sighup_child;
		
		my $live = get_live_title($url);
		if ($live) {
			my ($sec, $min, $hour, $day, $month, $year, $wday, $yday, $isdst) = localtime(time());
			$year += 1900; $month++;
			my $timestamp = sprintf('%04d-%02d-%02d_%02d-%02d-%02d', $year, $month, $day, $hour, $min, $sec);
			
			$artist = $name;
			$title = $live unless $title;
			$album = $timestamp;
			$releaseyear = $year;
			$filename = "${name}_${timestamp}";
			print STDERR " # child: start recording ${name} - ${title} at ${timestamp}\n" if $debug;
		} else {
			my $runmsecs = get_running_time($url);
			my $f = $runmsecs;
			my $s = $f / 1000; $f %= 1000;
			my $m = $s / 60; $s %= 60;
			my $h = $m / 60; $m %= 60;
			my $runtime = sprintf("%d:%02d:%02d.%03d", $h, $m, $s, $f);
			
			$title = get_title($url) unless $title;
			$artist = $name unless $artist;
			$album = $artist unless $album;
			$releaseyear = '2005' unless $releaseyear;
			$filename = $name;
			print STDERR " # child: start recording ${name}, running time: ${runtime}\n" if $debug;
			print "Clip length is ${runtime}\n" unless $debug;
		}
		
		if ($target) {
			$target .= '/' unless $target =~ /\/$/;
			$filename =~ s/^.*\///;
			$filename = $target . $filename;
		}
		$filename = $1 if $filename =~ /^(.*)\.mp3$/;
		record($filename, $title, $artist, $album, $releaseyear);
		
		print " # child: adding id3v1 tag\n" if $debug;
		system "id3v2 -t \'${title}\' -a \'${artist}\' -A \'${album}\' -y ${releaseyear} ${filename}.mp3";
		
		print " # child: killing parent\n" if $debug;
		kill 'HUP', getppid;
		print STDERR " # child: Exiting with code ${exitcode}\n" if $debug;
		exit $exitcode;
	} elsif ($! =~ /No more process/) {
		print STDERR " # no processes left, retry fork() in 5 sec.\n" if $debug;
		sleep 5;
		redo FORK;
	} else {
		die "Can't fork: $!\n";
	}
}

print STDERR " # parent: Exiting with code ${exitcode}\n" if $debug;
exit $exitcode;