| blib/lib/WWW/Domain/Registry/Afilias.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % | 
| statement | 6 | 6 | 100.0 | 
| branch | n/a | ||
| condition | n/a | ||
| subroutine | 2 | 2 | 100.0 | 
| pod | n/a | ||
| total | 8 | 8 | 100.0 | 
| line | stmt | bran | cond | sub | pod | time | code | 
|---|---|---|---|---|---|---|---|
| 1 | package WWW::Domain::Registry::Afilias; | ||||||
| 2 | |||||||
| 3 | 4 | 4 | 102033 | use strict; | |||
| 4 | 9 | ||||||
| 4 | 159 | ||||||
| 4 | 4 | 4 | 23 | use base qw/Class::Accessor/; | |||
| 4 | 7 | ||||||
| 4 | 6658 | ||||||
| 5 | use warnings; | ||||||
| 6 | use Carp; | ||||||
| 7 | use WWW::Mechanize; | ||||||
| 8 | |||||||
| 9 | __PACKAGE__->mk_accessors(qw(mech)); | ||||||
| 10 | |||||||
| 11 | our $VERSION = '0.01'; | ||||||
| 12 | |||||||
| 13 | sub new { | ||||||
| 14 | my ($class, $id, $password) = @_; | ||||||
| 15 | my $self = bless {}, $class; | ||||||
| 16 | $self->{reg} = { | ||||||
| 17 | base => 'https://admin.afilias.net', | ||||||
| 18 | id => $id, | ||||||
| 19 | password => $password, | ||||||
| 20 | }; | ||||||
| 21 | $self->mech(WWW::Mechanize->new); | ||||||
| 22 | $self; | ||||||
| 23 | } | ||||||
| 24 | |||||||
| 25 | sub login { | ||||||
| 26 | my $self = shift; | ||||||
| 27 | $self->mech->get($self->{reg}->{base} .'/'); | ||||||
| 28 | $self->mech->post($self->{reg}->{base} .'/login.do', | ||||||
| 29 | { | ||||||
| 30 | user => $self->{reg}->{id}, | ||||||
| 31 | pass => $self->{reg}->{password}, | ||||||
| 32 | "login_submit" => 'Login', | ||||||
| 33 | } | ||||||
| 34 | ); | ||||||
| 35 | $self->parse_login($self->mech->content); | ||||||
| 36 | } | ||||||
| 37 | |||||||
| 38 | sub parse_login { | ||||||
| 39 | my ($self, $content) = @_; | ||||||
| 40 | $content =~ m/Account Information/; | ||||||
| 41 | } | ||||||
| 42 | |||||||
| 43 | sub home { | ||||||
| 44 | my $self = shift; | ||||||
| 45 | $self->mech->get($self->{reg}->{base} .'/home.do'); | ||||||
| 46 | $self->parse_home($self->mech->content); | ||||||
| 47 | } | ||||||
| 48 | |||||||
| 49 | sub parse_home { | ||||||
| 50 | my ($self, $content) = @_; | ||||||
| 51 | my $content_from = qq( );  | ||||||
| 52 | my $content_till = qq(); | ||||||
| 53 | return unless $content =~ /$content_from(.*?)$content_till/s; | ||||||
| 54 | $content = $1; | ||||||
| 55 | $content =~ s,<(br|/?p|/div|/tr)>\n,,g; | ||||||
| 56 | $content =~ s, | ||||||
| 57 | $content =~ s, | 
,s;
Account Information
);