File Coverage

blib/lib/Mojo/Cloudflare/Record.pm
Criterion Covered Total %
statement 16 42 38.1
branch 2 18 11.1
condition 4 18 22.2
subroutine 4 9 44.4
pod 3 3 100.0
total 29 90 32.2


line stmt bran cond sub pod time code
1             package Mojo::Cloudflare::Record;
2              
3             =head1 NAME
4              
5             Mojo::Cloudflare::Record - Represent a Cloudflare DNS record
6              
7             =head1 DESCRIPTION
8              
9             L represents a DNS record in the
10             L module.
11              
12             This module inherit from L.
13              
14             =cut
15              
16 3     3   11 use Mojo::Base 'Mojo::JSON::Pointer';
  3         4  
  3         13  
17 3     3   339 use Mojo::JSON::Pointer;
  3         6  
  3         9  
18 3     3   58 use Mojo::UserAgent;
  3         10  
  3         12  
19              
20             require Mojo::Cloudflare;
21              
22             =head1 ATTRIBUTES
23              
24             =head2 content
25              
26             $str = $self->content;
27             $self = $self->content($str);
28              
29             The content of the DNS record, will depend on the the type of record being
30             added.
31              
32             This attribute is required to do anything useful with this object.
33              
34             =head2 id
35              
36             $str = $self->id;
37              
38             The identifier from Cloudflare. Can only be set in constructor.
39              
40             =head2 name
41              
42             $str = $self->name;
43             $self = $self->name($str);
44              
45             Name of the DNS record.
46              
47             This attribute is required to do anything useful with this object.
48              
49             =head2 priority
50              
51             $int = $self->priority;
52             $self = $self->priority($int);
53              
54             MX record priority.
55              
56             =head2 ttl
57              
58             $int = $self->ttl;
59             $self = $self->ttl($int);
60              
61             TTL of record in seconds. 1 (default) = Automatic, otherwise, value must in
62             between 120 and 86400 seconds.
63              
64             =head2 service_mode
65              
66             $int = $self->service_mode;
67             $self = $self->service_mode($int);
68              
69             Status of CloudFlare Proxy:
70             1 = orange cloud (active),
71             0 = grey cloud (deactive).
72              
73             =head2 type
74              
75             $str = $self->type;
76             $self = $self->type($str);
77              
78             Type of the DNS record: A, CNAME, MX, TXT, SPF, AAAA, NS, SRV, or LOC.
79              
80             This attribute is required to do anything useful with this object.
81              
82             =cut
83              
84             for my $attr (qw( content name priority type )) {
85             has $attr => sub { $_[0]->get("/$attr") || $_[0]->get("/obj/$attr") || "" };
86             }
87              
88             sub id {
89 0   0 0 1 0 $_[0]->{id} ||= $_[0]->get("/rec_id") || $_[0]->get("/obj/rec_id") || "";
      0        
90             }
91              
92             has service_mode => '';
93             has ttl => sub { shift->data->{ttl} || 1 };
94              
95             # Will be public once I know what to call the attribute
96             has _cf => sub { Mojo::Cloudflare->new };
97              
98             =head1 METHODS
99              
100             =head2 delete
101              
102             $self = $self->delete(sub { my($self, $err) = @_; ... });
103             $self = $self->delete; # die $err on failure
104              
105             Used to save delete record from Cloudflare.
106              
107             =cut
108              
109             sub delete {
110 0     0 1 0 my ($self, $cb) = @_;
111              
112 0         0 $self->_cf->_post({a => 'rec_delete', id => $self->id, _class => $self}, $cb);
113             }
114              
115             =head2 save
116              
117             $self = $self->save(sub { my($self, $err) = @_; ... });
118             $self = $self->save; # die $err on failure
119              
120             Used to save record to Cloudflare.
121              
122             =cut
123              
124             sub save {
125 0     0 1 0 my $self = shift;
126 0 0       0 return $self->id ? $self->_rec_edit(@_) : $self->_rec_new(@_);
127             }
128              
129             sub _new_from_tx {
130 2     2   4 my ($class, $tx) = @_;
131 2         7 my $err = $tx->error;
132 2   50     113 my $json = $tx->res->json || {};
133              
134 2   50     1270 $json->{result} //= '';
135 2 50 0     13 $err ||= $json->{msg} || $json->{result} || 'Unknown error.' if $json->{result} ne 'success';
      0        
136              
137 2 50       7 if (ref $class) { # object instead of class
138 0   0     0 my $obj = $json->{response}{rec}{obj} || {};
139 0         0 for my $k (keys %$obj) {
140 0         0 $class->data->{obj}{$k} = $obj->{$k};
141 0 0       0 $class->$k($obj->{$k}) if $class->can($k);
142             }
143 0         0 return $err, $class;
144             }
145             else {
146 2   100     31 return $err, $class->new($json->{response}{rec} || {});
147             }
148             }
149              
150             sub _rec_new {
151 0     0     my ($self, $cb) = @_;
152 0           my %args = map { ($_, $self->$_) } qw( content name ttl type );
  0            
153              
154 0           $args{_class} = $self;
155 0           $args{a} = 'rec_new';
156 0 0         $args{prio} = $self->priority if length $self->priority;
157              
158 0           return $self->_cf->_post(\%args, $cb);
159             }
160              
161             sub _rec_edit {
162 0     0     my ($self, $cb) = @_;
163 0           my %args = map { ($_, $self->$_) } qw( content name ttl type );
  0            
164              
165 0           $args{_class} = $self;
166 0           $args{a} = 'rec_edit';
167 0 0         $args{id} = $self->id or die "Cannot update record ($self->{name}) without 'id'";
168 0 0         $args{prio} = $self->priority if length $self->priority;
169 0 0         $args{service_mode} = $self->service_mode ? 1 : 0 if length $self->service_mode;
    0          
170              
171 0           return $self->_cf->_post(\%args, $cb);
172             }
173              
174             =head1 COPYRIGHT AND LICENSE
175              
176             Copyright (C) 2014, Jan Henning Thorsen
177              
178             This program is free software, you can redistribute it and/or modify it under
179             the terms of the Artistic License version 2.0.
180              
181             =head1 AUTHOR
182              
183             Jan Henning Thorsen - C
184              
185             =cut
186              
187             1;