#12 - ACT scrapper

Author: diegok

lib/X/ACT/Client.pm

@@ -0,0 +1,73 @@
+package X::ACT::Client;
+use Mojo::Base -base;
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+use Mojo::UserAgent;
+use Mojo::URL;
+
+has ua       => sub{ Mojo::UserAgent->new };
+has user     => sub{ die 'user attribute is required' };
+has password => sub{ die 'password attribute is required' };
+has url_base => sub{ Mojo::URL->new('http://workshop.barcelona.pm') };
+has project  => 'barcelona2016';
+
+sub login($self, $cb=undef) {
+    my @form = ( form => {
+        credential_0 => $self->user,
+        credential_1 => $self->password,
+        destination  => '/'. $self->project .'/main'
+    });
+
+    if ($cb) {
+        return $self->ua->post(
+            $self->_url('LOGIN'), @form, sub{ my $tx = pop; $cb->(@_, $self->_login($tx)) }
+        );
+    }
+
+    $self->_login( $self->ua->post( $self->_url('LOGIN'), @form ) );
+}
+sub _login($self, $tx) {
+    die 'Login has failed' unless $tx->res->code == 302;
+    $self;
+}
+
+sub userdata($self, $cb=undef) {
+    if ($cb) {
+        return $self->ua->get( $self->_url('change') => sub{
+            my $tx = pop;
+            $cb->(@_, _userdata($tx))
+        });
+    }
+
+    _userdata( $self->ua->get($self->_url('change')) );
+}
+sub _userdata($tx, $data={}) {
+    if ( my $err = $tx->error ) {
+      die "$err->{code} response: $err->{message}" if $err->{code};
+      die "Connection error: $err->{message}";
+    }
+
+    my $dom = $tx->res->dom;
+
+    my $selector = 'input[type="radio"][checked]'
+                 . ',input[type="email"]'
+                 . ',input[type="text"]';
+
+    $dom->find($selector)->each(sub{
+        $data->{$_->attr('name')} = $_->attr('value');
+    });
+    $dom->find('textarea')->each(sub{
+        $data->{$_->attr('name')} = $_->text;
+    });
+    $dom->find('select')->each(sub{
+        $data->{$_->attr('name')} = eval{$_->at('option[selected]')->attr('value')}||'';
+    });
+
+    $data;
+}
+
+sub _url($self, @path) {
+    $self->url_base->clone->path( '/'. join('/', $self->project, @path) );
+}
+
+1;

t/act-client.t

@@ -0,0 +1,46 @@
+use Test::More;
+
+require_ok( 'X::ACT::Client' );
+
+subtest 'User login and basic data retrieval (sync)' => sub {
+    plan( skip_all => 'This tests need ACT credentials as ACT_USER and ACT_PASSWORD' )
+        unless $ENV{ACT_USER} && $ENV{ACT_PASSWORD};
+
+    isa_ok(
+        my $client = X::ACT::Client->new( user => $ENV{ACT_USER}, password => $ENV{ACT_PASSWORD} ),
+        'X::ACT::Client' => 'Create an act client instance'
+    );
+
+    ok( $client->login, 'Client can login' );
+    ok( my $ud = $client->userdata, '... and get userdata()' );
+	ok( $ud->{$_}, "'$_' was retrieved" ) for qw/ email nick_name first_name last_name /;
+	for (qw/ tshirt_size web_page pm_group pause_id bio_en company vat address company_url town country gpg_key_id im monk_id nb_family /) {
+		diag( "$ENV{ACT_USER} has '$_'" ) if $ud->{$_};
+	}
+};
+
+subtest 'User login and basic data retrieval (async)' => sub {
+    plan( skip_all => 'This tests need ACT credentials as ACT_USER and ACT_PASSWORD' )
+        unless $ENV{ACT_USER} && $ENV{ACT_PASSWORD};
+
+    isa_ok(
+        my $client = X::ACT::Client->new( user => $ENV{ACT_USER}, password => $ENV{ACT_PASSWORD} ),
+        'X::ACT::Client' => 'Create an act client instance'
+    );
+
+    Mojo::IOLoop->delay(
+        sub { $client->login( shift->begin ) },
+        sub {
+            my ( $delay, $client ) = @_;
+            isa_ok( $client, 'X::ACT::Client', 'Async login() send client to the cb' );
+            $client->userdata( $delay->begin );
+        },
+        sub {
+            my $ud = pop;
+            isa_ok( $ud, 'HASH', 'Async userdata() send results to the cb' );
+            ok( $ud->{$_}, "'$_' was retrieved" ) for qw/ email nick_name first_name last_name /;
+        }
+    )->catch(sub{ fail(pop) })->wait;
+};
+
+done_testing();