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