Someone

#!/usr/bin/perl
# This program is free software. It comes without any warranty, to
# the extent permitted by applicable law. You can redistribute it
# and/or modify it under the terms of the Do What The Fuck You Want
# To Public License, Version 2, as published by Sam Hocevar. See
# http://sam.zoy.org/wtfpl/COPYING for more details.

use strict;
use URI;
use IO::Socket;

# Should really rewrite this using LWP, but this works despite being an evil
# hack.

my %ua = (
  coremedia => "Apple iPhone v1.1.1 CoreMedia v1.0.0.3A110a",
  safari => "Mozilla/5.0 (iPhone; U; CPU like Mac OS X; en) AppleWebKit/420.1 (KHTML, like Gecko) Version/3.0 Mobile/3A110a Safari/419.3",
);

my $id = $ARGV[0] || die "Usage: $0 id or url\n";
$id = $1 if $id =~ /\/(b.*?)\.shtml/;
my $page = "http://www.bbc.co.uk/iplayer/page/item/$id.shtml";

my $sock = iphone_req($page, "safari", "");

my($videourl, $video_id, $cookie, $title, $full, @vers);

while(<$sock>) {
  print if $ENV{DEBUG};

  if(/Location: (.*)/) {
    $videourl = $1;
    $sock = iphone_req($1, "coremedia", "Range: bytes=0-1\r\n");
  } elsif(/Set-Cookie: (BBC-UID.*?);/i) {
    $cookie = $1;

    my $text = join "", <$sock>; # keepalive causes a pause here

    @vers = ($text =~ /iplayer.versions.*?Original.*?'(\w+)/s);
    push @vers, $text =~ /iplayer.versions(?:.*?pid\s*:\s*'(\w+)')+/sg;

    if(@vers) {
      $video_id = shift @vers;

      if($text =~ m!<p class="heading">([^<]+)</p>(?:.*?<h2>(.*?)</h2>)?!s) {
        $title = "$1" . ($2 ? " - $2" : "");
        $title =~ s/[^-A-Z0-9 ']/ /ig;
        $title =~ s/(?:^\s+|\s+$)//g;
        $title =~ s/\s{2,}/ /g;
      } else {
        $title = $video_id;
      }

      $sock = iphone_req("http://www.bbc.co.uk/mediaselector/3/auth/iplayer_streaming_http_mp4/$video_id?" . int(rand 1e6) . "%20", "coremedia", "Range: bytes=0-1\r\n");
    } else {
      die "video id not found\n";
    }
  } elsif(!$full && /^Content-Range: .*\/(\d+)\r?$/) {
    $full = $1;
    $sock = iphone_req($videourl, "coremedia", "Range: bytes=0-$1\r\n");
  } elsif(/^\r?$/) {
    if(!$full) {
      if(@vers) { # try another version (maybe signed still available?)
        $video_id = shift @vers;
        $sock = iphone_req("http://www.bbc.co.uk/mediaselector/3/auth/iplayer_streaming_http_mp4/$video_id?" . int(rand 1e6) . "%20", "coremedia", "Range: bytes=0-1\r\n");
      } else {
        die "Didn't find anything to download!\n";
      }
    } else {
      save_to_file($sock, $full);
      exit;
    }
  }
}

my $prev_url;
sub iphone_req {
  my($url, $ua, $add) = @_;
  my $type = $prev_url ? "new_abs" : "new";
  $url = URI->$type($url, $prev_url) unless ref $url;
  $prev_url = $url;

  my $path = $url->path . ($url->query ? "?" . $url->query : "");
  my $host = $url->host;

  print "--> $path\n";

  my $req = <<EOF;
GET $path HTTP/1.1\r
Accept: */*\r
Accept-Language: en\r
Accept-Encoding: gzip, deflate\r
Cookie: $cookie\r
User-Agent: $ua{$ua}\r
Connection: keep-alive\r
${add}Host: $host\r
\r
EOF
  my $sock = IO::Socket::INET->new("$host:80") or die $!;
  print $sock $req;
  return $sock;
}

sub save_to_file {
  my($sock, $full) = @_;

  my $file = "$ENV{HOME}/Videos/$title.mp4";
  printf "\nSaving to $file (%0.1fMB)\n", $full/(1<<20);

  open my $fh, ">$file" or die $!;
  binmode $fh;
  binmode $sock;
  my $buf;
  my($s,$p);

  $|++;
  my $start = time;
  while($s=read $sock, $buf, 1<<16) {
    $p+=$s;
    printf "\r%0.2f%% (%0.2f KiB/s)",
      ($p/$full) * 100, $p / ((time - $start) || 1) / 1024;
    print $fh $buf or die "HMM!";
  }
}