#!/usr/bin/perl -w
# Copyright © 2007-2010 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Given a YouTube or Vimeo URL, downloads the corresponding MP4 file.
# The name of the file will be the <TITLE> of the HTML page.
#
#  --title "STRING"  Use this as the title instead.
#  --size            Instead of downloading it all, print video dimensions.
#		     This requires "mplayer" and/or "ffmpeg".
#
# You can also use it as a bookmarklet: put it somewhere on your web server
# as a .cgi, then bookmark this URL:
#
#   javascript:location='http://YOUR_SITE/youtubedown.cgi?url='+location
#
# or better,
#
#   javascript:location='http://YOUR_SITE/youtubedown.cgi?url='+location.toString().replace(new RegExp('&.*$'), '').replace('%23','%2523')
#
# When you click on that bookmarklet in your toolbar, it will give you
# a link on which you can do "Save Link As..." and be offered a sensible
# file name by default.
#
# Created: 25-Apr-2007.

require 5;
use diagnostics;
use strict;
use Socket;

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.51 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 1;
my $http_proxy = undef;

$ENV{PATH} = "/opt/local/bin:$ENV{PATH}";   # for macports mplayer


sub de_entify($) {
  my ($text) = @_;
  $text =~ s/&([a-zA-Z])(uml|acute|grave|tilde|cedil|circ|slash);/$1/g;
  $text =~ s/&lt;/</g;
  $text =~ s/&gt;/>/g;
  $text =~ s/&amp;/&/g;
  $text =~ s/&(quot|ldquo|rdquo);/"/g;
  $text =~ s/&(rsquo|apos);/'/g;
  return $text;
}


sub url_quote($) {
  my ($u) = @_;
  $u =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge;
  return $u;
}

sub url_unquote($) {
  my ($u) = @_;
  $u =~ s/[+]/ /g;
  $u =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
  return $u;
}

sub html_quote($) {
  my ($u) = @_;
  $u =~ s/&/&amp;/g;
  $u =~ s/</&lt;/g;
  $u =~ s/>/&gt;/g;
  $u =~ s/\"/&quot;/g;
  return $u;
}


# Loads the given URL, returns: $http, $head, $body.
#
sub get_url_1($;$$$$) {
  my ($url, $referer, $head_p, $to_file, $max_bytes) = @_;
  
  error ("can't do HEAD and write to a file") if ($head_p && $to_file);

  error ("not an HTTP URL, try rtmpdump: $url") if ($url =~ m@^rtmp@i);
  error ("not an HTTP URL: $url") unless ($url =~ m@^(http|feed)://@i);

  my ($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
  $path = "" unless $path;

  my ($them,$port) = split(/:/, $serverstring);
  $port = 80 unless $port;

  my $them2 = $them;
  my $port2 = $port;
  if ($http_proxy) {
    $serverstring = $http_proxy if $http_proxy;
    $serverstring =~ s@^[a-z]+://@@;
    ($them2,$port2) = split(/:/, $serverstring);
    $port2 = 80 unless $port2;
  }

  my ($remote, $iaddr, $paddr, $proto, $line);
  $remote = $them2;
  if ($port2 =~ /\D/) { $port2 = getservbyname($port2, 'tcp') }
  if (!$port2) {
    error ("unrecognised port in $url");
  }

  $iaddr = inet_aton($remote);
  error ("host not found: $remote") unless ($iaddr);

  $paddr   = sockaddr_in($port2, $iaddr);


  my $head = "";
  my $body = "";

  $proto   = getprotobyname('tcp');
  if (!socket(S, PF_INET, SOCK_STREAM, $proto)) {
    error ("socket: $!");
  }
  if (!connect(S, $paddr)) {
    error ("connect: $serverstring: $!");
  }

  select(S); $| = 1; select(STDOUT);

  my $user_agent = "$progname/$version";

  my $hdrs = (($head_p ? "HEAD " : "GET ") .
              ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" .
              "Host: $them\r\n" .
              "User-Agent: $user_agent\r\n");
  if ($referer) {
    $hdrs .= "Referer: $referer\r\n";
  }
  $hdrs .= "\r\n";

  if ($verbose > 3) {
    foreach (split('\r?\n', $hdrs)) {
      print STDERR "  ==> $_\n";
    }
  }
  print S $hdrs;
  my $http = <S> || "";

  $_  = $http;
  s/[\r\n]+$//s;
  print STDERR "  <== $_\n" if ($verbose > 3);

  # If the URL isn't there, don't write to the file.
  $to_file = undef unless ($http =~ m@^HTTP/[0-9.]+ 20\d@si);

  while (<S>) {
    $head .= $_;
    s/[\r\n]+$//s;
    last if m@^$@;
    print STDERR "  <== $_\n" if ($verbose > 3);
  }

  print STDERR "  <== \n" if ($verbose > 4);

  local *OUT;
  if ($to_file) {
    open (OUT, ">$to_file") || error ("$to_file: $!");
  }

  my $lines = 0;
  my $bytes = 0;
  while (<S>) {
    if ($to_file) {
      print OUT $_;
      $bytes += length($_);
      last if ($max_bytes && $bytes >= $max_bytes);
    } else {
      s/\r\n/\n/gs;
      $_ .= "\n" unless ($_ =~ m/\n$/s);
      print STDERR "  <== $_" if ($verbose > 4);
      $body .= $_;
      $lines++;
    }
  }

  if ($to_file) {
    close OUT || error ("$to_file: $!");
    print STDERR "  <== [ body ]: $bytes bytes to file \"$to_file\"\n"
      if ($verbose > 3);
  } else {
    print STDERR "  <== [ body ]: $lines lines, " . length($body) . " bytes\n"
      if ($verbose == 4);
  }

  close S;

  if (!$http) {
    error ("null response: $url");
  }

  return ($http, $head, $body);
}


# Loads the given URL, processes redirects.
# Returns: $http, $head, $body, $final_redirected_url.
#
sub get_url($;$$$$) {
  my ($url, $referer, $head_p, $to_file, $max_bytes) = @_;

  print STDERR "$progname: " . ($head_p ? "HEAD" : "GET") . " $url\n"
    if ($verbose > 2);

  my $orig_url = $url;
  my $loop_count = 0;
  my $max_loop_count = 10;

  do {
    my ($http, $head, $body) = 
      get_url_1 ($url, $referer, $head_p, $to_file, $max_bytes);

    $http =~ s/[\r\n]+$//s;

    if ( $http =~ m@^HTTP/[0-9.]+ 30[123]@ ) {
      $_ = $head;

      my ( $location ) = m@^location:[ \t]*(.*)$@im;
      if ( $location ) {
        $location =~ s/[\r\n]$//;

        print STDERR "$progname: redirect from $url to $location\n"
          if ($verbose > 3);

        $referer = $url;
        $url = $location;

        if ($url =~ m@^/@) {
          $referer =~ m@^(http://[^/]+)@i;
          $url = $1 . $url;
        } elsif (! ($url =~ m@^[a-z]+:@i)) {
          $_ = $referer;
          s@[^/]+$@@g if m@^http://[^/]+/@i;
          $_ .= "/" if m@^http://[^/]+$@i;
          $url = $_ . $url;
        }

      } else {
        error ("no Location with \"$http\"");
      }

      if ($loop_count++ > $max_loop_count) {
        error ("too many redirects ($max_loop_count) from $orig_url");
      }

    } else {
      return ($http, $head, $body, $url);
    }
  } while (1);
}


sub check_http_status($$$) {
  my ($url, $http, $err_p) = @_;
  return 1 if ($http =~ m@^HTTP/[0-9.]+ 20\d@si);
  error ("$http: $url") if ($err_p);
  return 0;
}


# Runs mplayer and/or ffmpeg to determine dimensions of the given video file.
#
sub video_file_size($) {
  my ($file) = @_;

  # Sometimes mplayer gets stuck in a loop.  
  # Don't let it run for more than N CPU-seconds.
  my $limit = "ulimit -t 10";

  $file =~ s/"/\\"/gs;
  my $cmd = "mplayer -identify -frames 0 -vc null -vo null -ao null \"$file\"";

  $cmd = "$limit; $cmd";
  $cmd .= ' </dev/null';
  if ($verbose > 2) {
    $cmd .= ' 2>&1';
  } else {
    $cmd .= ' 2>/dev/null';
  }

  print STDERR "\n$progname: exec: $cmd\n" if ($verbose > 2);
  my $result = `$cmd`;
  print STDERR "\n$result\n" if ($verbose > 2);

  my ($w, $h) = (0, 0);
  if ($result =~ m/^VO:.*=> (\d+)x(\d+) /m) {
    ($w, $h) = ($1, $2);
  }


  # If mplayer failed to determine the video dimensions, try ffmpeg.
  #
  if (!$w) {
    $cmd = "ffmpeg -i \"$file\" -vframes 0 -f null /dev/null </dev/null 2>&1";
    print STDERR "\n$progname: exec: $cmd\n" if ($verbose > 2);
    $cmd = "$limit; $cmd";
    my $result = `$cmd`;
    print STDERR "\n$result\n" if ($verbose > 2);

    if ($result =~ m/^\s*Stream #.* Video:.* (\d+)x(\d+) /m) {
      ($w, $h) = ($1, $2);
    }
  }

  my $size = (stat($file))[7];
  return ($w, $h, $size);
}


# Downloads the first 200 KB of the URL, then runs mplayer to find out
# the dimensions of the video.
#
sub video_url_size($$$) {
  my ($title, $id, $url) = @_;

  my $file = sprintf ("%s/youtubedown.%08x",
                      ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
                      rand(0xFFFFFFFF));
  unlink $file;

  my $bytes = 200 * 1024;	   # 200 KB seems to be enough for 1280x760

  my ($http, $head, $body) = get_url ($url, undef, 0, $file, $bytes);
  check_http_status ($url, $http, 1);

  my ($ct) = ($head =~ m/^content-type:\s*([^\s;&]+)/mi);
  error ("expected video, got \"$ct\" in $url")
    if ($ct =~ m/text/i);

  my ($size) = ($head =~ m/^content-length:\s*(\d+)/mi);
  $size = -1 unless defined($size); # WTF?

  my ($w, $h) = video_file_size ($file);
  unlink $file;

  return ($w, $h, $size);
}


# Generates HTML output that provides a link for direct downloading of
# the highest-resolution underlying video.  The HTML also lists the
# video dimensions and file size, if possible.
#
sub cgi_output($$$$$$$) {
  my ($title, $file, $id, $url, $w, $h, $size) = @_;

  if (! ($w && $h)) {
    ($w, $h, $size) = video_url_size ($title, $id, $url);
  }

  $size = -1 unless defined($size);

  my $ss = ($size > 1024*1024 ? sprintf ("%dM", $size/(1024*1024)) :
            $size > 1024 ? sprintf ("%dK", $size/1024) :
            "$size bytes");
  $ss .= ", $w x $h" if ($w && $h);


  # I had hoped that transforming
  #
  #   http://v5.lscache2.googlevideo.com/videoplayback?ip=....
  #
  # into
  #
  #   http://v5.lscache2.googlevideo.com/videoplayback/Video+Title.mp4?ip=....
  #
  # would trick Safari into downloading the file with a sensible file name.
  # Normally Safari picks the target file name for a download from the final
  # component of the URL.  Unfortunately that doesn't work in this case,
  # because the "videoplayback" URL is sending
  #
  #   Content-Disposition: attachment; filename="video.mp4"
  #
  # which overrides my trickery, and always downloads it as "video.mp4"
  # regardless of what the final component in the path is.
  #
  # However, if you do "Save Link As..." on this link, the default file
  # name is sensible!  So it takes two clicks to download it instead of
  # one.  Oh well, I can live with that.

  $url = "$ENV{SCRIPT_NAME}/" . url_quote($file) . '?redir=' . url_quote($url);
  $url = html_quote ($url);

  print STDOUT ("Content-Type: text/html; charset=UTF-8\n" .
                "\n" .
                "<TITLE>Download \"$title\"</TITLE>\n" .
                #"<META HTTP-EQUIV=\"Refresh\" CONTENT=\"1;url=$url\">\n" .
                "Save Link As: " .
                "<A HREF=\"$url\">$title</A>, $ss.\n");
}


# Parses the video_info XML page and returns several values:
# - the content type and underlying URL of the video itself;
# - title, if known
# - width and height, if known
# - size in bytes, if known
#
sub scrape_youtube_url($$) {
  my ($url, $id) = @_;

  my $info_url = ("http://www.youtube.com/get_video_info?video_id=$id" .
                  "&el=vevo");	# Needed for VEVO, works on non-VEVO.

  my ($http, $head, $body) = get_url ($info_url);
  check_http_status ($url, $http, 1);

  my ($urlmap) = ($body =~ m@&fmt_url_map=([^&]+)@si);
  ($urlmap) = ($body =~ m@&fmt_stream_map=([^&]+)@si) unless $urlmap; # VEVO

  if (! $urlmap) {
    # If we couldn't get a URL map out of the info URL, try harder.

    if ($body =~ m/private[+\s]video/si) {  # scraping won't work.
      error ("$progname: $id: private video");
    }

    if ($verbose > 1) {
      if ($body =~ m/Embedding[+\s]disabled/si) {
        print STDERR "$progname: $id: embedding disabled, scraping HTML...\n";
      } else {
        print STDERR "$progname: $id: no fmt_url_map, scraping HTML...\n";
      }
    }
    return scrape_youtube_url_noembed ($url, $id);
  }

  $urlmap = url_unquote ($urlmap);

  my ($title) = ($body =~ m@&title=([^&]+)@si);
  error ("no title in $info_url") unless $title;
  $title = url_unquote($title);

  return scrape_youtube_url_2 ($id, $urlmap, $title);
}


# This version parses the HTML, since the video_info page is unavailable
# for "embedding disabled" videos.
#
sub scrape_youtube_url_noembed($$) {
  my ($url, $id) = @_;

  my ($http, $head, $body) = get_url ($url);
  check_http_status ($url, $http, 1);

  my ($args) = ($body =~ m@'SWF_ARGS' *: *{(.*?)}@s);

  if (! $args) {    # Sigh, new way as of Apr 2010...
    ($args) = ($body =~ m@var swfHTML = [^"]*"(.*?)";@si);
    $args =~ s@\\@@gs if $args;
    ($args) = ($args =~ m@<param name="flashvars" value="(.*?)">@si) if $args;
    ($args) = ($args =~ m@fmt_url_map=([^&]+)@si) if $args;
    $args = "\"fmt_url_map\": \"$args\"" if $args;
  }

  if (! $args) {
    error ("$id: $1") 
      if ($body =~ m@<div\s+id="error-box"[^<>]*>\s*([^<>]+?)\s*</div>@si);
    error ("$id: $1") 
      if ($body =~ 
          m@<div[^<>]*class="yt-alert-content"[^<>]*>\s*([^<>]+?)\s*</div>@si);
    error ("$id: no SWF_ARGS in $url");
  }

  my ($urlmap) = ($args =~ m@"fmt_url_map": "(.*?)"@s);
  ($urlmap) = ($args =~ m@"fmt_stream_map": "(.*?)"@s) unless $urlmap; # VEVO

  error ("$id: no fmt_url_map in $url") unless $urlmap;

  $urlmap = url_unquote($urlmap);

  my ($title) = ($body =~ m@<title>\s*(.*?)\s*</title>@si);
  $title = munge_title (url_unquote ($title));

  return scrape_youtube_url_2 ($id, $urlmap, $title);
}


# Parses the given fmt_url_map to determine the preferred URL of the
# underlying Youtube video.
#
sub scrape_youtube_url_2($$$) {
  my ($id, $urlmap, $title) = @_;

  my $url;
  my %urlmap;
  my @urlmap;
  foreach (split /,/, $urlmap) {
    my ($k, $v) = m/^(.*?)\|(.*)$/s;
    $urlmap{$k} = $v;
    push @urlmap, $k;
  }

  # fmt    video codec           video size               audio codec
  # --- -------------------  -------------------  ---------------------------
  #  0  FLV h.263  251 Kbps  320x180  29.896 fps  MP3  64 Kbps  1ch 22.05 KHz
  #  5  FLV h.263  251 Kbps  320x180  29.896 fps  MP3  64 Kbps  1ch 22.05 KHz
  #  5* FLV h.263  251 Kbps  320x240  29.896 fps  MP3  64 Kbps  1ch 22.05 KHz
  #  6  FLV h.263  892 Kbps  480x270  29.887 fps  MP3  96 Kbps  1ch 44.10 KHz
  # 13  3GP h.263   77 Kbps  176x144  15.000 fps  AMR  13 Kbps  1ch  8.00 KHz
  # 17  3GP  xVid   55 Kbps  176x144  12.000 fps  AAC  29 Kbps  1ch 22.05 KHz
  # 18  MP4 h.264  505 Kbps  480x270  29.886 fps  AAC 125 Kbps  2ch 44.10 KHz
  # 18* MP4 h.264  505 Kbps  480x360  24.990 fps  AAC 125 Kbps  2ch 44.10 KHz
  # 22  MP4 h.264 2001 Kbps 1280x720  29.918 fps  AAC 198 Kbps  2ch 44.10 KHz
  # 34  FLV h.264  256 Kbps  320x180  29.906 fps  AAC  62 Kbps  2ch 22.05 KHz
  # 34* FLV h.264  593 Kbps  320x240  25.000 fps  AAC  52 Kbps  2ch 22.05 KHz
  # 34* FLV h.264  593 Kbps  640x360  30.000 fps  AAC  52 Kbps  2ch 22.05 KHz
  # 35  FLV h.264  831 Kbps  640x360  29.942 fps  AAC 107 Kbps  2ch 44.10 KHz
  # 37  MP4 h.264 3653 Kbps 1920x1080 29.970 fps  AAC 128 Kbps  2ch 44.10 KHz
  # 38  MP4 h.264 6559 Kbps 4096x2304 23.980 fps  AAC 128 Kbps  2ch 48.00 KHz
  #
  # fmt=38/37/22 are only available if upload was that exact resolution.
  #
  # fmt=34 used to always be worse than fmt=18, but more recent uploads seem
  # to be better.  So we'll assume 34 is better than 18 from now on.
  #
  # Sadly, as of Jun 2010, there still exist older videos (uploaded as
  # recently as Nov 2008) where 18 is much better than 34.  Maybe we should
  # take whichever one is first in the list instead?
  #
  my %known_formats = (0  => 1, 5  => 1, 6  => 1, 13 => 1, 17 => 1, 18 => 1,
                       22 => 1, 34 => 1, 35 => 1, 37 => 1, 38 => 1 );
  my @preferred_fmts = (38, 37, 22, 35, 34, 18);
  my $fmt;
  foreach my $k (@preferred_fmts) {
    $fmt = $k;
    $url = $urlmap{$fmt};
    last if defined($url);
  }

  # If none of our preferred formats are available, use first one in the list.
  if (! defined($url)) {
    $fmt = $urlmap[0];
    $url = $urlmap{$fmt};
  }

  print STDERR "$progname: $id: available formats: " . 
    join(', ', @urlmap) . "; picked $fmt.\n"
      if ($verbose > 1);


  # If there is a format in the list that we don't know about, warn.
  # This is the only way I have of knowing when new ones turn up...
  #
  my @unk = ();
  foreach my $k (@urlmap) {
    push @unk, $k if (!$known_formats{$k});
  }
  print STDERR "$progname: $id: unknown format " . join(', ', @unk) .
               ": please report URL to jwz\@jwz.org!\n"
      if (@unk);


  $url =~ s@^.*?\|@@s;  # VEVO

  my ($http, $head, $body);
  ($http, $head, $body, $url) = get_url ($url, undef, 1);
  check_http_status ($url, $http, 1);
  my ($ct)   = ($head =~ m/^content-type:\s*([^\s;]+)/mi);
  my ($size) = ($head =~ m/^content-length:\s*(\d+)/mi);

  error ("couldn't find video for $url") unless $ct;

  # If we knew width and height, we'd return those too, but we don't.
  return ($ct, $url, $title, undef, undef, $size);
}


# Parses the HTML and returns several values:
# - the content type and underlying URL of the video itself;
# - title, if known
# - width and height, if known
# - size in bytes, if known
#
sub scrape_vimeo_url($$) {
  my ($url, $id) = @_;

  my $info_url = "http://www.vimeo.com/moogaloop/load/clip:$id";
  my ($http, $head, $body) = get_url ($info_url);
  check_http_status ($url, $http, 1);

  my ($sig) = ($body =~ m@<request_signature>([^<>]+)</@si);
  if (! $sig) {
    error ("$id: $1") if ($body =~ m@<error_id>([^<>]+)</@si);
    error ("$id: no signature in $info_url");
  }
  my ($exp) = ($body =~ m@<request_signature_expires>([^<>]+)</@si);
  error ("$id: no expiration in $info_url") unless ($exp);

  my ($w) = ($body =~ m@<width>(\d+)</@si);
  my ($h) = ($body =~ m@<height>(\d+)</@si);
  my ($title) = ($body =~ m@<caption>([^<>]+)</@si);

  $url = "http://www.vimeo.com/moogaloop/play/clip:$id/$sig/$exp/?q=hd";

  my ($ct, $size);
  ($http, $head, $body) = get_url ($url, undef, 1);

  ($ct) = ($head =~ m/^content-type:\s*([^\s;]+)/mi);

  if (! check_http_status ($url, $http, 0) ||
      $ct !~ m@^video/@si) {
    $url =~ s/q=hd\b/q=sd/s;
    ($http, $head, $body) = get_url ($url, undef, 1);
    check_http_status ($url, $http, 1);
  }

  ($ct)   = ($head =~ m/^content-type:\s*([^\s;]+)/mi);
  ($size) = ($head =~ m/^content-length:\s*(\d+)/mi);

  error ("couldn't find video for $url") unless $ct;

  return ($ct, $url, $title, $w, $h, $size);
}


# Copied from youtubedown
sub munge_title($) {
  my ($title) = @_;
  $title =~ s/\s+/ /gsi;
  $title =~ s/^Youtube - //si;
  $title =~ s/ on Vimeo\s*$//si;
  $title = '' if ($title eq 'Broadcast Yourself.');
  $title =~ s@: @ - @sg;    # colons, slashes not allowed.
  $title =~ s@[:/]@ @sg;
  $title =~ s@\s+$@@gs;

  # Do some simple rewrites / clean-ups to dumb things people do.
  $title =~ s/\s*[[(].*?\b(video|hd|hq)[])]\s*$//gsi; # yes I know it's a video
  $title =~ s/^([^"]+) ['"](.*)['"]\s*$/$1 - $2/gsi;  #  foo "bar" => foo - bar
  $title =~ s/ -+ *-+ / - /gsi;

  return $title;
}


sub download_video_url($;$$$) {
  my ($url, $title, $size_p, $cgi_p) = @_;

  # Rewrite Vimeo URLs so that we get a page with the proper video title:
  # "/...#NNNNN" => "/NNNNN"
  $url =~ s@^(http://([a-z]+\.)?vimeo\.com/)[^\d].*\#(\d+)$@$1$3@s;

  my ($id, $site, $playlist_p);

  # Youtube /watch?v= or /watch#!v= or /v/ URLs. 
  if ($url =~ m@^http:// (?:[a-z]+\.)? (youtube) \.com/
			 (?: (?: watch )? (?: \? | \#! ) v= | v/ )
			 ([^<>?&,'"]+) ($|&) @sx) {
    ($site, $id) = ($1, $2);
    $url = "http://www.$site.com/watch?v=$id";

  # Youtube /view_play_list?p= or /p/ URLs. 
  } elsif ($url =~ m@^http://(?:[a-z]+\.)?(youtube)\.com/
		(?:view_play_list\?p=|p/) ([^<>?&,]+) ($|&) @sx) {
    ($site, $id) = ($1, $2);
    $url = "http://www.$site.com/view_play_list?p=$id";
    $playlist_p = 1;

  # Youtube "/verify_age" URLs.
  } elsif ($url =~ 
           m@^http://(?:[a-z]+\.)?(youtube)\.com/.*next_url=([^&]+)@s) {
    $site = $1;
    $url = url_unquote($2);
    $url =~ s@&.*$@@s;
    ($id) = ($url =~ m@(?: watch (?: \? | \#! ) v= | v/ )
		       ([^<>?&,'"]+) ($|&) @sx);
    error ("unparsable verify_age next_url: $url") unless $id;

  # Youtube "/user" and "/profile" URLs.
  } elsif ($url =~ 
     m@^http://(?:[a-z]+\.)?(youtube)\.com/(?:user|profile).*#.*/([^&/]+)@s) {
    $site = $1;
    $id = url_unquote($2);
    $url = "http://www.$site.com/watch?v=$id";
    error ("unparsable user next_url: $url") unless $id;

  # Vimeo /NNNNNN URLs.
  } elsif ($url =~ m@^http://(?:[a-z]+\.)?(vimeo)\.com/(\d+)@s) {
    ($site, $id) = ($1, $2);

  # Vimeo /videos/NNNNNN URLs.
  } elsif ($url =~ m@^http://(?:[a-z]+\.)?(vimeo)\.com/.*/videos/(\d+)@s) {
    ($site, $id) = ($1, $2);

  } else {
    error ("no ID in $url" . ($title ? " ($title)" : ""))
      unless ($id);
  }

  if ($playlist_p) {
    return download_playlist ($id, $url, $title, $size_p, $cgi_p);
  }

  my ($file, $ofile);

  # If we already have a --title, we can check for the existence of the file
  # before hitting the network.  Otherwise, we need to download the video
  # info to find out the title and thus the file name.
  #
  if (defined($title)) {
    $title = munge_title ($title);
    $file  = de_entify ("$title.mp4");
    $ofile = de_entify ("$title.flv");

    if (! $size_p) {
      error ("exists: $ofile") if (-f $ofile);
      error ("exists: $file")  if (-f $file);
    }
  }

  my ($ct, $w, $h, $size, $title2);

  # Get the video metadata (URL of underlying video, title, and size)
  #
  if ($site eq 'youtube') {
    ($ct, $url, $title2, $w, $h, $size) = scrape_youtube_url ($url, $id);
  } else {
    ($ct, $url, $title2, $w, $h, $size) = scrape_vimeo_url ($url, $id);
  }

  # Set the title unless it was specified on the command line with --title.
  #
  if (! defined ($title)) {
    $title = munge_title ($title2);
    $file  = de_entify ("$title.mp4");
    $ofile = de_entify ("$title.flv");
  }

  $file = $ofile if ($ct && $ct =~ m/flv/s);  # use proper extensions

  if ($size_p) {
    if (! ($w && $h)) {
      ($w, $h, $size) = video_url_size ($title, $id, $url);
    }
    print STDOUT "$id\t$w x $h\t$title\n";

  } elsif ($cgi_p) {
    cgi_output ($title, $file, $id, $url, $w, $h, $size);

  } else {

    # Might be checking twice, if --title was specified.
    error ("exists: $ofile") if (-f $ofile);
    error ("exists: $file")  if (-f $file);

    print STDERR "$progname: downloading \"$title\"\n" if ($verbose);

    my ($http, $head, $body) = get_url ($url, undef, 0, $file);
    check_http_status ($url, $http, 1);

    if (! -s $file) {
      unlink ($file);
      error ("$file: failed: $url");
    }

    if ($verbose) {
      my ($w, $h, $size) = video_file_size ($file);
      $size = -1 unless $size;
      my $ss = ($size > 1024*1024 ? sprintf ("%dM", $size/(1024*1024)) :
                $size > 1024 ? sprintf ("%dK", $size/1024) :
                "$size bytes");
      $ss .= ", $w x $h" if ($w && $h);
      print STDERR "$progname: wrote \"$file\", $ss\n";
    }
  }
}


sub download_playlist($$$$$) {
  my ($id, $url, $title, $size_p, $cgi_p) = @_;

  # max-results is ignored if it is >50, so this will fail on any
  # playlist with more than 50 entries in it.
  my $data_url = ("http://gdata.youtube.com/feeds/api/playlists/$id?v=2" .
                  "&max-results=50" .
                  "&fields=title,entry(title,link)" .
                  "&strict=true");

  my ($http, $head, $body) = get_url ($data_url, undef, 0, undef);
  check_http_status ($url, $http, 1);

  ($title) = ($body =~ m@<title>\s*([^<>]+?)\s*</title>@si)
    unless $title;
  $title = 'Untitled Playlist' unless $title;

  $body =~ s@(<entry)@\001$1@gs;
  my @entries = split(m/\001/, $body);
  shift @entries;
  my $i = 0;
  print STDERR "$progname: playlist \"$title\" (" . ($#entries+1) .
               " entries)\n"
    if ($verbose > 1);
  foreach my $entry (@entries) {
    my ($t2) = ($entry =~ m@<title>\s*([^<>]+?)\s*</title>@si);
    my ($u2, $id2) =
      ($entry =~ m@<link.*?href=['"]
                   (http://[a-z.]+/
                   (?: watch (?: \? | \#! ) v= | v/ )
                   ([^<>?&,'"]+))@sxi);
    $t2 = sprintf("%s: %02d: %s", $title, ++$i, $t2);
    download_video_url ($u2, $t2, $size_p, $cgi_p);

    # With "--size", only get the size of the first video.
    # With "--size --size", get them all.
    last if ($size_p == 1);
  }
}


sub do_cgi() {
  $|=1;

  my $args = "";
  if (!defined ($ENV{REQUEST_METHOD})) {
  } elsif ($ENV{REQUEST_METHOD} eq "GET") {
    $args = $ENV{QUERY_STRING} if (defined($ENV{QUERY_STRING}));
  } elsif ($ENV{REQUEST_METHOD} eq "POST") {
    while (<STDIN>) { $args .= $_; }
  }

  if (!$args &&
      defined($ENV{REQUEST_URI}) && 
      $ENV{REQUEST_URI} =~ m/\?(.*)$/s) {
    $args = $1;
  }

  my ($url, $redir);
  foreach (split (/&/, $args)) {
    my ($key, $val) = m/^([^=]+)=(.*)$/;
    $key = url_unquote ($key);
    $val = url_unquote ($val);
    if ($key eq 'url') { $url = $val; }
    elsif ($key eq 'redir') { $redir = $val; }
    else { error ("unknown option: $key"); }
  }

  if ($redir) {
    error ("can't specify both url and redir") if ($url);
    my $name = $ENV{PATH_INFO} || '';
    $name =~ s@^/@@s;
    $name = $redir unless $name;
    $name =~ s@"@%22@gs;
    print STDOUT ("Content-Type: text/html\n" .
                  "Location: $redir\n" .
                  "Content-Disposition: attachment; filename=\"$name\"\n" .
                  "\n" .
                  "<A HREF=\"$redir\">$name</A>\n" .
                  "\n");

  } elsif ($url) {
    error ("extraneous crap in URL: $ENV{PATH_INFO}")
      if (defined($ENV{PATH_INFO}) && $ENV{PATH_INFO} ne "");
    download_video_url ($url, undef, 0, 1);

  } else {
    error ("no URL specified for CGI");
  }
}


sub error($) {
  my ($err) = @_;

  if (defined ($ENV{HTTP_HOST})) {
    $err =~ s/&/&amp;/gs;
    $err =~ s/</&lt;/gs;
    $err =~ s/>/&gt;/gs;
    print STDOUT ("Content-Type: text/html\n" .
                  "Status: 500\n" .
                  "\n" .
                  "<P><B>ERROR:</B> " . $err . "<P>\n");
  } else {
    print STDERR "$progname: $err\n";
  }
  exit 1;
}


sub usage() {
  print STDERR "usage: $progname [--verbose] [--title title] [--size] youtube-urls...\n";
  exit 1;
}

sub main() {

  # historical suckage: the environment variable name is lower case.
  $http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY};

  if ($http_proxy && $http_proxy =~ m@^http://([^/]*)/?$@ ) {
    # historical suckage: allow "http://host:port" as well as "host:port".
    $http_proxy = $1;
  }

  my @urls = ();
  my $title = undef;
  my $size_p = 0;

  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if (m/^--?verbose$/) { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^--?title$/) { $title = shift @ARGV; }
    elsif (m/^--?size$/) { $size_p++; }
    elsif (m/^-./) { usage; }
    else { 
      error ("not a Youtube or Vimeo URL: $_")
        unless (m@^http://([a-z]+\.)?(youtube|vimeo)\.com/@s);
      my @pair = ($title, $_);
      push @urls, \@pair;
      $title = undef;
    }
  }

  return do_cgi() if (defined ($ENV{REQUEST_URI}));

  usage unless ($#urls >= 0);
  foreach (@urls) {
    my ($title, $url) = @$_;
    download_video_url ($url, $title, $size_p);
  }
}

main();
exit 0;