SVN: toys/fun/rsget.pl

[sparky]

Author: sparky
Date: Mon Jun  8 18:06:00 2009
New Revision: 10386

Modified:
   toys/fun/rsget.pl
Log:
- MU: support password protected downloads, to specify password
  add pass=<password> after URI:
  http://www.megaupload.com/?d=ID pass=PASS
- die if there is no space left - don't brake get.list
- update each entry in get.list only once - allow readding same source


Modified: toys/fun/rsget.pl
==============================================================================
--- toys/fun/rsget.pl   (original)
+++ toys/fun/rsget.pl   Mon Jun  8 18:06:00 2009
@@ -10,9 +10,7 @@
   to the same network if still in the wait stage
 - check all the URIs just after finding them in the list
   (catch non-existing files quickly)
-- restart download if same URI has been added second time
 - OdSiebie: there is a captcha now
-- MegaUpload: support password-protected downloads
 
 =item Status:
 - RS: 2009-06-07 OK
@@ -172,7 +170,8 @@
 
        if ( $self->{file} ) {
                my $file = $self->{file};
-               print $file $chunk;
+               my $p = print $file $chunk;
+               die "\nCannot write data: $!\n" unless $p;
        } else {
                $self->{body} .= $chunk;
        }
@@ -425,6 +424,10 @@
                $slots = scalar @outaddr;
        }
 
+       my @opts = split /\s+/, $url;
+       $url = shift @opts;
+       my %opts = map { /(.*?)=(.*)/ ? ( $1, $2 ) : ( $_, 1 ) } @opts;
+
        return {} if $gotlist{ $url };
        $running{ $net } = {} unless exists $running{ $net };
        my $rn = $running{ $net };
@@ -462,6 +465,7 @@
        my $self = {
                @_,
                url => $url,
+               opts => \%opts,
                id => $id,
                try => 0,
                line => $line,
@@ -1069,6 +1073,8 @@
        @ISA = qw(Get);
 }
 
+use URI::Escape;
+
 sub new
 {
        my $proto = shift;
@@ -1098,6 +1104,14 @@
                        or $body =~ /This file has expired due to inactivity/ ) 
{
                return $self->error( "file not found" );
        }
+       if ( $body =~ /The file you're trying to download is password 
protected/ ) {
+               return $self->error( "password required" )
+                       unless exists $self->{opts}->{pass};
+
+               my $pass = uri_escape( $self->{opts}->{pass} );
+               my $post = "filepassword=$pass";
+               return $self->curl( "", \&stage4, post => $post );
+       }
        my %search = (
                captcha_img => qr#<img 
src="(http://.*/gencap\.php\?[0-9a-f]+\.gif)"#,
                s2icode => qr#<INPUT type="hidden" name="captchacode" 
value="(.*?)"#,
@@ -1129,7 +1143,7 @@
 
        my $post = 
"captchacode=$self->{s2icode}&megavar=$self->{s2mevagar}&captcha=$captcha";
 
-       $self->curl( $self->{action}, \&stage4, post => $post );
+       $self->curl( "", \&stage4, post => $post );
 }
 
 sub stage4
@@ -1141,6 +1155,9 @@
        if ( $body =~ /id="captchaform"/ ) {
                return $self->stage1( @_ );
        }
+       if ( $body =~ /The file you're trying to download is password 
protected/ ) {
+               return $self->error( "invalid password" );
+       }
 
        my $wait;
        if ( $body =~ /count=([0-9]+);/ ) {
@@ -1592,6 +1609,7 @@
        return unless $checklist or $mtime != $listmtime;
 
        my @newlist;
+       my @updated;
        open my $list, '<', $get_list;
        while ( my $line = <$list> ) {
                if ( $line =~ /^\s*(#.*)?$/ ) {
@@ -1608,8 +1626,10 @@
                }
 
                if ( $getter ) {
-                       if ( exists $gotlist{$uri} ) {
-                               push @newlist, "# " . $gotlist{$uri} . ":\n# " 
. $line;
+                       ( my $only_uri = $uri ) =~ s/\s+.*//;
+                       if ( exists $gotlist{$only_uri} ) {
+                               push @newlist, "# " . $gotlist{$only_uri} . 
":\n# " . $line;
+                               push @updated, $only_uri;
                        } else {
                                push @newlist, $uri . "\n";
                                &{$getters{ $getter }->{add}}( $uri );
@@ -1620,9 +1640,12 @@
        }
        close $list;
        unless ( -e ".${get_list}.swp" ) {
-               open my $newlist, '>', $get_list;
+               open my $newlist, '>', $get_list . ".tmp";
                print $newlist @newlist;
-               close $newlist;
+               close $newlist || die "\nCannot update $get_list file: $!\n";
+               unlink $get_list;
+               rename $get_list . ".tmp", $get_list;
+               delete $gotlist{ $_ } foreach @updated;
        }
 
        $checklist = 0;
_______________________________________________
pld-cvs-commit mailing list
pld-cvs-commit@lists.pld-linux.org
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit