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
);