comment on

is code changed. and very good. My Code.

#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple;
use LWP::UserAgent;
use CGI qw(:standard);
print "Content-type:text/html\n\n";
my $query = new CGI;
print qq~
<html>
<head>
<style>
div{
position:absolute;
}
</style>
</head>
<body>
<form name="aa" action="" method="get">
<INPUT TYPE="hidden" name="islem" value="1">
<textarea name="url" cols="25" rows="6" OnFocus="this.value=''">
Lütfen Youtube Linkini buraya yapıştırınız.
</textarea>
<INPUT TYPE="submit" name="submit" value="İndir">
</form>
~;
my $myurl  = $query -> param('url');
my $islem  = $query -> param('islem');
 
 if ($islem eq "1") {

# shamelessly reversed engineered from a python script :-)

#print "starting first page retrieval\n";
my $urlin  = shift || $myurl; ###"http://www.youtube.com/watch?v=0Q3Uv
+6_jXzg";
my $content = get( $urlin  ) or die "argh : $!\n";
#print "done first page retrieval : $urlin\n";

# print "$content" ;
# regex for 2 key text strings which identify the video file
# the second one $2 is unique for each download attempt
# $content =~ /player2\.swf\?video_id=([^&]+)&.*t=([^&]+)&/ ;

my $infile     = ($content =~ m{<title>([^<]+)</title>})[0] . '.flv';
my ($video_id) = ($content =~ /watch_fullscreen\?(?:.*?)video_id=([^&]
+++)/);
my ($t_id)     = ($content =~ /watch_fullscreen\?(?:.*?)t=([^&]+)/);
$infile =~ s/YouTube/Seyret/isg;
$infile =~ s/[\*]//isg;
$infile = normalize_filename($infile,'-', 40);
my $kaydet="flv/".$infile;
my $get_url = "http://www.youtube.com/get_video?video_id=$video_id&t=$
+t_id";

#print "gettin video file : $infile\n";

print qq~
<B>Dosya Adı :</B> $infile<br>
<B>Tamamlama Yüzdesi :</B> <div id=yuzde></div><br>
<B>Hız :</B> <div id=hiz></div><br>
<B>Alınan :</B> <div id=alma></div><br>
~;

# don't buffer the prints to make the status update
$| = 1;

open(IN,"> $kaydet") or die "$_\n";

my $ua = LWP::UserAgent->new();
my $received_size = 0;
my $url = $get_url;
#print "Fetching $url\n";
my $request_time = time;
my $last_update = 0;
my $response = $ua->get($url,
                        ':content_cb'     => \&callback,
                        ':read_size_hint' => 8192,
                       );
print "\n";
close IN;
print "\nBitti</body></html>";
#play the flv file with mplayer
# system( "mplayer $infile" );


#############################################

sub callback {
  my ($data, $response, $protocol) = @_;

  my $total_size = $response->header('Content-Length') || 0;
  $received_size += length $data;

  # write the $data to a filehandle or whatever should happen
  # with it here.
  print IN $data;

  my $time_now = time;

  # this to make the status only update once per second.
  return unless $time_now > $last_update or $received_size == $total_s
+ize;
  $last_update = $time_now;

  #print "\rReceived $received_size bytes\n\n";
  #printf " (%i%%)", (100/$total_size)*$received_size if $total_size;
printf "<script>document.all.yuzde.innerHTML='(%i%%)';</script>",(100/
+$total_size)*$received_size if $total_size;
printf "<script>document.all.hiz.innerHTML='%6.1f - KB';</script>", ($
+received_size*8)/1024/(($time_now-$request_time)||1)  if $received_si
+ze;
printf "<script>document.all.alma.innerHTML='%i-KB / %i KB';</script>"
+, ($received_size/1024),($total_size)/1024  if $total_size;
}

sub random_string{
    my $length_of_randomstring = shift;
    my @chars=('a'..'z','A'..'Z','0'..'9');
    my $random_string;
    
    for(my $i = 0; $i < $length_of_randomstring; $i++){ $random_string
+ .= $chars[int(rand(58))]; }
    
    return $random_string;
}

sub normalize_filename{ 
    my $file_name = shift;
    my $delimiter = shift;
    my $max_file_length = shift;
    
    if(length($file_name) > $max_file_length){ $file_name = substr($fi
+le_name, length($file_name) - $max_file_length); }
    
    $file_name =~ s/[^a-zA-Z0-9\_\.\-]/$delimiter/g;

    return $file_name;
}

 }
[download]

In reply to Re: YouTube Video Downloader by Anonymous Monk
in thread YouTube Video Downloader by zentara

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Pathologically Eclectic Rubbish Lister
	PerlMonks