File Coverage

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


\n,,g;
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,
\n,,g; 58             $content =~ s, ,,g; 59               60             my $data; 61             return unless $content =~ m,>Account balance: (.*?)<,s; 62             $data->{balance} = $1; 63             return unless $content =~ m,>Domain names created in your account yesterday:(.*?)

,s; 64             $data->{yesterday} = $1; 65               66             while ($content =~ m{(.+)(.+)\n}ig) { 67             my($key, $val) = ($1, $2); 68             $val =~ s/^\s+//; 69             $val =~ s/\s+$//; 70             $val =~ s/\n+/\n/g; 71             $data->{lc($key)} = $val; 72             } 73               74             return $data; 75             } 76               77             sub account { 78             my $self = shift; 79             $self->mech->get($self->{reg}->{base} .'/account.do'); 80             $self->parse_account($self->mech->content); 81             } 82               83             sub parse_account { 84             my ($self, $content) = @_; 85               86             my $content_from = qq(

Account Information

); 87             my $content_till = qq(
); 88             return unless $content =~ /$content_from(.*?)$content_till/s; 89             $content = $1; 90             $content =~ s, ,,g; 91               92             my $data; 93             while ($content =~ m{(.+)(.*)\n}ig) { 94             my($key, $val) = ($1, $2); 95             $val =~ s/^\s+//; 96             $val =~ s/\s+$//; 97             $val =~ s/\n+/\n/g; 98             $data->{lc($key)} = $val; 99             } 100               101             return $data; 102             } 103               104             # Preloaded methods go here. 105               106             1; 107             __END__