Perl Download Manager
Intro
This is my PERL downloader program, with resume.
Only works if SERVER has Parts enabled.
Well pretty much thats it
#!/usr/bin/perl
use strict;
use threads;
use threads::shared;
use HTTP::Request;
use HTTP::Response;
use Math::Round qw(nearest);
use LWP;
exit unless(defined $ARGV[0] && -e $ARGV[0]);
open HND,$ARGV[0];
NEXT:
while(my $url = <HND>)
{
my $file = substr($url,rindex($url,"/")+1);
$file =~ s/%20/_/g;
chomp $url;
exit if($url eq "" || $file eq "");
print "Downloading $url \n to $file \n";
our @stats:shared = (0,0,0,0,0,0,0,0,0,0,0,0,0,0);
our $exit:shared = 0;
our $tdl:shared = 0;
our $tgl:shared = 0;
our $lastime:shared = time();
our $lasdl:shared = 0;
my $folder = "/home/arun/download/";
select STDOUT; $| = 1;
sub catchintr()
{
my $who = shift;
print "\n$who is Bugging me\nDownload Paused\nExit message dispatched";
$exit = 1;
}
$SIG{INT} = \&catchintr;
$SIG{HUP} = \&catchintr;
sub dloader
{
select STDOUT; $| = 1;
my ($inx,$url,$localfile,$blockstart,$blockend) = @_;
my $length = $blockend - $blockstart + 1;
my $stbit = 0;
if(-f $localfile)
{
open HND, $localfile or die $!;
binmode HND;
seek HND,0,2;
$stbit = tell HND;
close HND;
$tdl += $stbit;
}
else
{
open HND,">$localfile" or die $!;
print HND "";
close HND;
}
my $ua = LWP::UserAgent->new;
my $pcksize = 1024*64;
my $enbit = $stbit+$pcksize-1;
my $parts = int($length / $pcksize)+1;
$enbit = $length - 1 if($enbit > $length);
my $err =0;
my $i = int($stbit / $pcksize);
my $req = HTTP::Request->new('GET',$url);
if($stbit >= $length)
{
print "$localfile Part Complete! $length <=> $stbit\n";
$stats[$inx] = 1;
return;
}
while($stbit < ($length-1) && $err < 100)
{
my $stbit2 = $stbit + $blockstart;
my $enbit2 = $enbit + $blockstart;
my $range = "bytes=$stbit2-$enbit2";
$req->header('Range' => $range);
$i++;
print "\n $inx ... $i / $parts ";
my $res = $ua->request($req);
threads->yield();
if($res->code == 206)
{
open HND, ">>$localfile";
binmode HND;
print HND $res->content;
close HND;
$stbit = $stbit + $pcksize;
$enbit = $stbit + $pcksize - 1;
$enbit = $length - 1 if($enbit > $length);
$tdl += $pcksize;
if($tdl < 1024)
{
print "[$tdl] bytes";
}
elsif($tdl < 1024 * 1024)
{
print "[".nearest(0.01,$tdl/1024,)." KB]";
}
else
{
print "[".nearest(0.01,$tdl/1048576)." MB]";
}
if((time()-$lastime) > 0)
{
print " [ ".nearest(0.01,($tdl-$lasdl) / (1024 * (time() - $lastime) ) ). " kB/s ] ";
$lasdl = $tdl;
$lastime = time();
}
}
elsif($res->code == 416)
{
print "\n\nSeems complete";
exit;
}
else
{
print "\nGlitch $err : ";
print $res->code;
print "\nResuming...\n";
sleep 1;
$i--;
$err++;
}
if($exit)
{
print "\n$inx is exiting ";
$stats[$inx] = 1;
return 0;
}
}
if($err == 100)
{
print "\nToo many errors in $inx, killing everyone\n";
$exit = 1;
}
$stats[$inx] = 1;
return $err;
}
my $errls = 0;
REDO:
my $req = HTTP::Request->new('HEAD',$url);
print $req->as_string;
my $ua = LWP::UserAgent->new;
my $res = $ua->request($req);
print $res->as_string;
if($res->code != 200)
{
print "\n\n";
goto REDO if($errls++ < 10);
}
my $length = $res->header('Content-Length');
$tgl = $length;
my $req = HTTP::Request->new('HEAD',$url);
$req->header('Range' => 'bytes=0-99');
my $res = $ua->request($req);
print $res->as_string;
if($res->code != 206)
{
print "Parts cant be used!\n:(\n";
goto NEXT;
}
if(!defined $length)
{
$length=-1;
print "Missing Length
Any Idea? : ";
$length = <>;
print "\n";
}
my $blocks = 8;
my $blocksize = ($length + $blocks - $length % $blocks) / $blocks;
if($blocksize < 1024 * 512)
{
$blocks = 4;
$blocksize = ($length + $blocks - $length % $blocks) / $blocks;
}
#print $blocksize," ",$blocksize*$blocks," ",$length;
my $blockstart = 0;
my @thread = ();
print "\nthreading Gatherers ...\n";
my ($blockend);
for(my $i=1;$i<=$blocks;$i++)
{
$blockend = $blockstart + $blocksize;
$blockend = $length if($blockend > $length);
$thread[$i] = threads->new(sub{dloader($i,$url,$folder."$file.$i.part",$blockstart,$blockend)});
$blockstart = $blockend + 1;
}
my $flag = 0;
do
{
$flag = 0;
for(my $i=1;$i<=$blocks;$i++)
{
$flag = 1 if($stats[$i] == 0);
}
sleep 1;
}
while($flag);
if($exit)
{
open STAT,">>$folder"."$file.stat";
print STAT "".localtime;
print STAT " : Downloaded $tdl / $tgl bytes ".($tdl*100/$tgl)."%\n";
close STAT;
exit;
}
print "\n\ngathering Gatherers...\n";
print "\nMerging ... ";
open OUT,">$file";
binmode OUT;
for(my $i=1;$i<=$blocks;$i++)
{
print "\n+ ".$folder."$file.$i.part";
open IN, $folder."$file.$i.part";
binmode IN;
my $buffer;
print OUT $buffer while(read(IN,$buffer,65536));
close IN;
unlink $folder."$file.$i.part";
}
close OUT;
print "\nDone :)\n";
open STAT,">>$folder$file.stat";
print STAT "".localtime;
print STAT " : Finished Downloading $tdl / $tgl bytes \n";
close STAT;
}
close HND;
3 comments:
Hi, i was taking a read at your Orkut articles/scripts.I need something to send a scrap to everyone in specified orkut communities.Do you have such script? Thanks!!!
axl_rose_80s@yahoo.com
ninne kondu thottu..program ezhuthi marikkum allo nee...
Good day. I will appreciate if you address my issues as below:
1. Which editor these scripts shall run or shall use command prompt?
2. How to use it on Servers like rapidshare.com or file hosting servers which support resume but use deferred download? Meanwhile I mean as a free account user.
Thanks & Good Luck
Post a Comment