/usr/share/perl5/FlashVideo/Mechanize.pm is in get-flash-videos 1.25~git2012.06.27-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | # Part of get-flash-videos. See get_flash_videos for copyright.
package FlashVideo::Mechanize;
use WWW::Mechanize;
use FlashVideo::Downloader;
use Encode ();
use strict;
use base "WWW::Mechanize";
sub new {
my $class = shift;
my $browser = $class->SUPER::new(autocheck => 0);
$browser->agent_alias("Windows Mozilla");
my $proxy = $App::get_flash_videos::opt{proxy};
if ($proxy) {
if ($proxy =~ /^(\w+):?(\d+)?$/) {
# Proxy is in format:
# localhost:1337
# localhost
# Add a scheme so LWP can use it.
# Other formats are passed to LWP directly.
my ($host, $port) = ($1, $2);
$port ||= 1080; # socks by default
$proxy = "socks://$host:$port";
print STDERR "Using proxy server $proxy\n"
if $App::get_flash_videos::opt{debug};
$browser->proxy([qw[http https]] => $proxy);
}
}
if($browser->get_socks_proxy) {
if(!eval { require LWP::Protocol::socks }) {
die "LWP::Protocol::socks is required for SOCKS support, please install it\n";
}
}
return $browser;
}
sub redirect_ok {
my($self) = @_;
return $self->{redirects_ok};
}
sub allow_redirects {
my($self) = @_;
$self->{redirects_ok} = 1;
}
sub get {
my($self, @rest) = @_;
print STDERR "-> GET $rest[0]\n" if $App::get_flash_videos::opt{debug};
my $r = $self->SUPER::get(@rest);
if($App::get_flash_videos::opt{debug}) {
my $text = join " ", $self->response->code,
$self->response->header("Content-type"), "(" . length($self->content) . ")";
$text .= ": " . DBI::data_string_desc($self->content) if eval { require DBI };
print STDERR "<- $text\n";
}
return $r;
}
sub update_html {
my($self, $html) = @_;
my $charset = _parse_charset($self->response->header("Content-type"));
# If we have no character set in the header (therefore it is worth looking
# for a http-equiv in the body) or the content hasn't been decoded (older
# versions of Mech).
if($LWP::UserAgent::VERSION < 5.827
&& (!$charset || !Encode::is_utf8($html))) {
# HTTP::Message helpfully decodes to iso-8859-1 by default. Therefore we
# do the inverse. This is fucking frail and will probably break.
$html = Encode::encode("iso-8859-1", $html) if Encode::is_utf8($html);
# Check this doesn't look like a video..
if(!FlashVideo::Downloader->check_magic($html)) {
my $p = HTML::TokeParser->new(\$html);
while(my $token = $p->get_tag("meta")) {
my($tag, $attr) = @$token;
if($tag eq 'meta' && $attr->{"http-equiv"} =~ /Content-type/i) {
$charset ||= _parse_charset($attr->{content});
}
}
if($charset) {
eval { $html = Encode::decode($charset, $html) };
FlashVideo::Utils::error("Failed decoding as $charset: $@") if $@;
}
}
}
return $self->SUPER::update_html($html);
}
sub _parse_charset {
my($field) = @_;
return(($field =~ /;\s*charset=([-_.:a-z0-9]+)/i)[0]);
}
sub get_socks_proxy {
my $self = shift;
my $proxy = $self->proxy("http");
if(defined $proxy && $proxy =~ m!^socks://(.*?):(\d+)!) {
return "$1:$2";
}
return "";
}
1;
|