SVN: toys/rsget.pl/Get/MegaUpload

sparky sparky at pld-linux.org
Wed Oct 21 21:51:30 CEST 2009


Author: sparky
Date: Wed Oct 21 21:51:30 2009
New Revision: 10800

Modified:
   toys/rsget.pl/Get/MegaUpload
Log:
- updated to use newest tools
- Image::Magick not required anymore but highly recomended


Modified: toys/rsget.pl/Get/MegaUpload
==============================================================================
--- toys/rsget.pl/Get/MegaUpload	(original)
+++ toys/rsget.pl/Get/MegaUpload	Wed Oct 21 21:51:30 2009
@@ -10,10 +10,22 @@
 status: OK 2009-08-24
 
 pre:
-	use Image::Magick;
+	my @captcha_solver;
 
 	my $mu_font_db = data_file( "mu_font_db.png" );
-	die "Font DB '$mu_font_db' does not exist\n" unless $mu_font_db;
+	eval {
+		die "Font DB 'mu_font_db.png' does not exist\n" unless $mu_font_db;
+
+		require Image::Magick;
+		my $dbf = new Image::Magick;
+		$dbf->Read( $mu_font_db );
+		die "Cannot open image $mu_font_db\n" unless $dbf->Get( "width" );
+	};
+	if ( $@ ) {
+		warn "MegaUpload: Unable to use native captcha solver: $@\n";
+	} else {
+		@captcha_solver = ( solver => \&mu_captcha );
+	}
 
 unify:
 	my ($id) = /d=([A-Z0-9]*)/;
@@ -43,7 +55,7 @@
 		my $form;
 		! $form = $self->form( id => "passwordform" );
 		$form->set( filepassword => $-{_opts}->{pass} );
-		GET_NEXT( stage_last, $form->post() );
+		CLICK_NEXT( stage_last, $form->post() );
 	}
 
 	! $-{form} = $self->form( id => "captchaform" );
@@ -53,16 +65,23 @@
 
 	GET( $1, keep_referer => 1 );
 
-	my $captcha = captcha( \$_ );
-	RESTART( -1, "can't read captcha" ) unless defined $captcha;
+	CAPTCHA( qr/[A-HKMNP-Z]{3}[1-9]{1}/,
+		@captcha_solver,
+		process => \&mu_decaptcha
+	);
+
+	RESTART( -1, "can't read captcha" ) unless defined $_;
 
-	$-{form}->set( captcha => $captcha );
+	$-{form}->set( captcha => $_ );
 	GET( $-{form}->post() );
 
 	$-{form} = $self->form( id => "captchaform" );
 	if ( $-{form} ) {
+		CAPTCHA_RESULT( "FAIL" );
 		PRINT( "invalid captcha" );
 		GOTO stage_captcha;
+	} else {
+		CAPTCHA_RESULT( "OK" );
 	}
 
 stage_last:
@@ -75,11 +94,18 @@
 	! /count=([0-9]+);/;
 	WAIT( $1, "starting download" );
 
-	DOWNLOAD( $-{file_uri} );
+	CLICK_DOWNLOAD( $-{file_uri} );
 
 
 perl:
 	
+sub mu_decaptcha
+{
+	my $img = shift;
+	$img->color_filter( sub { shift } );
+	return $img->doublesize->ocr();
+}
+
 my %size = (
 	A => 28, B => 22, C => 21, D => 27, E => 16,
 	F => 16, G => 26, H => 26, K => 20, M => 38,
@@ -90,7 +116,7 @@
 
 my @db;
 
-sub read_db()
+sub mu_captcha_read_db()
 {
 	my $dbf = new Image::Magick;
 	$dbf->Read( $mu_font_db );
@@ -115,7 +141,7 @@
 	}
 }
 
-sub get_char
+sub mu_captcha_get_char
 {
 	my ($src, $db, $width, $x) = @_;
 
@@ -142,11 +168,11 @@
 	return $best_char;
 }
 
-sub captcha
+sub mu_captcha
 {
 	my $data_ref = shift;
 
-	read_db() unless @db;
+	mu_captcha_read_db() unless @db;
 
 	open IMAGE, '>', '.captcha.gif';
 	print IMAGE $$data_ref;
@@ -165,10 +191,10 @@
 	$bg->Composite( image => $img );
 
 	my @cap;
-	push @cap, get_char( $bg, $db[0], 40, 0 );
-	push @cap, get_char( $bg, $db[1], 40, $size{$cap[0]} - 6 );
-	push @cap, get_char( $bg, $db[2], 40, $width - 56 );
-	push @cap, get_char( $bg, $db[3], 22, $width - 22 );
+	push @cap, mu_captcha_get_char( $bg, $db[0], 40, 0 );
+	push @cap, mu_captcha_get_char( $bg, $db[1], 40, $size{$cap[0]} - 6 );
+	push @cap, mu_captcha_get_char( $bg, $db[2], 40, $width - 56 );
+	push @cap, mu_captcha_get_char( $bg, $db[3], 22, $width - 22 );
 
 	return join "", @cap;
 }


More information about the pld-cvs-commit mailing list