view release on metacpan or  search on metacpan

lib/FlashVideo/Generic.pm  view on Meta::CPAN

  }

  if (%swf_urls) {
    foreach my $swf_url (keys %swf_urls) {
      if (my ($flv_url, $title) = search_for_flv_in_swf($browser, $swf_url)) {
        return $flv_url, title_to_filename($title);
      }
    }
  }

  die "No URLs found";
}

sub search_for_flv_in_swf {
  my ($browser, $swf_url) = @_;

  $browser = $browser->clone();

  $browser->get($swf_url);

  if (!$browser->success) {
    die "Couldn't download SWF URL $swf_url: " .
      $browser->response->status_line();
  }

  # SWF data might be compressed.
  my $swf_data = $browser->content;

  if ('C' eq substr $swf_data, 0, 1) {
    if (eval { require Compress::Zlib }) {
      $swf_data = Compress::Zlib::uncompress(substr $swf_data, 8);
    }
    else {
      die "Compress::Zlib is required to uncompress compressed SWF files.\n";
    }
  }

  if ($swf_data =~ m{(http://.{10,300}?\.flv)}i) {
    my $flv_url = $1;

    my $filename = uri_unescape(File::Basename::basename(URI->new($flv_url)->path()));
    $filename =~ s/\.flv$//i;

    return ($flv_url, $filename);
  }

  return;
}

sub find_file_param {
  my($browser, $param, $prefs) = @_;

  for my $file($param =~ /(?:video|movie|file|path)_?(?:href|src|url)?['"]?\s*[=:,]\s*['"]?([^&'" ]+)/gi,
      $param =~ /(?:config|playlist|options)['"]?\s*[,:=]\s*['"]?(http[^'"&]+)/gi,
      $param =~ /['"=](.*?@{[EXTENSIONS]})/gi,
      $param =~ /([^ ]+@{[EXTENSIONS]})/gi,
      $param =~ /SWFObject\(["']([^"']+)/) {

    debug "Found $file";

    my ($actual_url, $filename, $filename_is_reliable) = guess_file($browser, $file, '', $prefs);

    if(!$actual_url && $file =~ /\?(.*)/) {
      # Maybe we have query params?
      debug "Trying query param on $1";

      for my $query_param(split /[;&]/, $1) {
        my($query_key, $query_value) = split /=/, $query_param;
        debug "Found $query_value from $query_key";

        ($actual_url, $filename, $filename_is_reliable)
          = guess_file($browser, $query_value, '', $prefs);

        last if $actual_url;
      }
    }

    if($actual_url) {
      my $possible_filename = $filename || (split /\//, $actual_url)[-1];

      return $actual_url, $possible_filename, $filename_is_reliable;
    }
  }

  if($param =~ m{(rtmp://[^ &"']+)}) {
    info "This looks like RTMP ($1), no generic support yet..";
  }
  
  return;
}

sub guess_file {
  my($browser, $file, $once, $prefs) = @_;

  # Contains lots of URI encoding, so try escaping..
  $file = uri_unescape($file) if scalar(() = $file =~ /%[A-F0-9]{2}/gi) > 3;

  my $orig_uri = URI->new_abs($file, $browser->uri);

  info "Guessed $orig_uri trying...";

  if($orig_uri) {
    my $uri = url_exists($browser->clone, $orig_uri);

    if($uri) {
      # Check to see if this URL is for a supported site.
      my ($package, $url) = FlashVideo::URLFinder->find_package($uri,
        $browser->clone);

      if($package && $package ne __PACKAGE__) {
        debug "$uri is supported by $package.";
        (my $browser_on_supported_site = $browser->clone())->get($uri);
        return $package->find_video($browser_on_supported_site, $uri, $prefs), 1;
      }

      my $content_type = $browser->response->header("Content-type");

      if($content_type =~ m!^(text|application/xml)!) {
        # Just in case someone serves the video itself as text/plain.
        $browser->add_header("Range", "bytes=0-10000");
        $browser->get($uri);
        $browser->delete_header("Range");

        if(FlashVideo::Downloader->check_magic($browser->content)
            || $uri =~ m!$video_re!) {
          # It's a video..
          debug "Found a video at $uri";
          return $uri;
        }

        # If this looks like HTML we have no hope of guessing right, so
        # give up now.
        return if $browser->content =~ /<html[^>]*>/i;

        if($browser->content =~ m!($video_re)!) {
          # Found a video URL
          return $1;
        } elsif(!defined $once
            && $browser->content =~ m!(http[-:/a-zA-Z0-9%_.?=&]+)!i) {
          # Try once more, one level deeper..
          return guess_file($browser, $1, 1, $prefs);
        } else {
          info "Tried $uri, but no video URL found";
        }
      } elsif($content_type =~ m!application/! && $uri ne $orig_uri) {
        # We were redirected, maybe something in the new URL?
        return((find_file_param($browser, $uri))[0]);
      } else {
        return $uri->as_string;
      }
    } elsif(not defined $once) {
      # Try using the location of the .swf file as the base, if it's different.
      if($browser->content =~ /["']([^ ]+\.swf)/) {
        my $swf_uri = URI->new_abs($1, $browser->uri);
        if($swf_uri) {
          my $new_uri = URI->new_abs($file, $swf_uri);
          debug "Found SWF: $swf_uri -> $new_uri";
          if($new_uri ne $uri) {
            return guess_file($browser, $new_uri, 1, $prefs);
          }
        }
      }
    }
  }

  return;
}

1;