#!/usr/bin/perl -w

###  Written by qbxk for perlmonks
###  It is provided as is with no warranties, express or implied, of any kind. Use posted code at your own risk.

$|++;
use warnings;
use strict;
use Net::HTTP;
use Data::Dumper;
use Carp::Assert;

# use constant USER_AGENT => 'WinampMPEG/2.9';  # I got refused by some public servers unlessen i done it thar way
use constant USER_AGENT => 'Stream-Recorder-0.01';

my %HOST = ( 
   host => 'server.com', port => 8000, mount => '/stream'
);

use constant DEBUG => 1;

sub debug(@) { print STDERR "\n" . join("\n", @_) . "\n"; }
sub debug_raw(@) { print STDERR @_; }

sub open_connection {
   my %args = (
      host => undef,
      port => 80,
      mount => '',
      user_agent => USER_AGENT,
      @_
   );
   
   die "Need a host name" unless defined($args{host});
   
   $args{mount} =~ s/^\/+//g;

   my $sock = Net::HTTP->new(Host => $args{host}, PeerPort => $args{port} ) || die $@;
   $sock->write_request(GET => "/$args{mount}", 'User-Agent' => $args{user_agent}, 'Icy-MetaData' => 1) or die $@;
   
   # my ($code, $mess, %headers) = $sock->read_response_headers( laxed => 1 )

   my ($code, $mess, %headers);
   while( <$sock> ) {
      s/\s*$//g;
      last if /^\s*$/;
      
      if( /^(?:HTTP\/1\.[01]|ICY) ([0-9]+) (.+)$/ ) {
         ($code, $mess) = ($1 +0, $2);
      }
      else {
         my ($h, $v) = split(/:/);
         $headers{$h} = $v;
      }
   }
   return ($sock,$code,$mess,%headers);
}

main: {

   my ($s,$code, $mess, %headers) = open_connection( %HOST );
  
   debug "$code|$mess\n" . Dumper(\%headers);
 
   # TODO: timeout on $s.

   exit if( $code != 200 ); # scream and shout

   my ($metaint) = map { (/^icy-metaint$/i && $headers{$_}) or () } keys %headers;
      assert( $metaint > 0 );

   open OUT, '>stream-out.mp3';
   binmode OUT; # very important

   while( 1 ) {   
      my $buf;
      $s->read($buf, $metaint);
      print OUT $buf;
      
      my ($metadata, $metalen, $metabyte);
      
      $s->read($metabyte, 1);
      $metalen = unpack("C",$metabyte) * 16;

      if( $metalen > 0) {
         #We have NEW metadata! JOY
         $s->read($metadata, $metalen);
         $metadata = unpack("A$metalen", $metadata);
         assert( $metadata =~ /Stream/, "Not good metadata!" ); #don't dump a lot of BS (binary *#$!), just die.
         
         debug "$metalen - [$metadata]";
      }
      else {
         $metadata = '';
         debug_raw "-";
      }
   }
}