File Coverage

blib/lib/DNS/EasyDNS.pm
Criterion Covered Total %
statement 56 72 77.7
branch 14 38 36.8
condition 0 3 0.0
subroutine 13 13 100.0
pod 3 3 100.0
total 86 129 66.6


line stmt bran cond sub pod time code
1             package DNS::EasyDNS;
2              
3             our $VERSION = 0.04;
4              
5             #==============================================================================#
6              
7             =head1 NAME
8              
9             DNS::EasyDNS - Update your EasyDNS dynamic DNS entries
10              
11             =head1 SYNOPSIS
12              
13             use DNS::EasyDNS;
14             my $ed = DNS::EasyDNS->new;
15             $ed->update( username => "foo", password => "bar" ) || die "Failed: $@";
16              
17             =head1 DESCRIPTION
18              
19             This module allows you to update your EasyDNS ( http://www.easydns.com/ )
20             dynamic DNS records. This is done via an http get using the L
21             modules.
22              
23             =head1 METHODS
24              
25             =over 4
26              
27             =cut
28              
29             #==============================================================================#
30              
31             package DNS::EasyDNS;
32              
33 1     1   24123 use strict;
  1         2  
  1         37  
34 1     1   5 use warnings;
  1         2  
  1         31  
35 1     1   5 use Carp;
  1         14  
  1         95  
36 1     1   10576 use LWP::UserAgent;
  1         153164  
  1         41  
37 1     1   1034 use CGI::Util qw(escape);
  1         4966  
  1         86  
38 1     1   2157 use HTTP::Request::Common qw(GET);
  1         2152  
  1         74  
39              
40 1     1   6 use base qw(LWP::UserAgent);
  1         1  
  1         112  
41              
42 1     1   7 use constant URL => 'members.easydns.com/dyn/dyndns.php';
  1         2  
  1         647  
43              
44             #==============================================================================#
45              
46             =item DNS::EasyDNS->new();
47              
48             Create a new EasyDNS object. This is actually an inheritted L
49             so you may like to use some of the UserAgent methods. For example,
50             if you are behind a proxy server:
51              
52             $ed->proxy('http', 'http://proxy.sn.no:8001/');
53              
54             =cut
55              
56             sub new {
57 1     1 1 11 my ($pack,@args) = @_;
58 1         14 my $obj = $pack->SUPER::new(@args);
59 1         4678 $obj->agent("DNS::EasyDNS perl module");
60 1         70 return $obj;
61             }
62              
63              
64             sub _can_do_https {
65 1     1   365 eval "use Crypt::SSLeay";
  0     1   0  
  0         0  
  1         77  
66              
67 1 50       6 if ($@) {
68 1         3 return;
69             } else {
70 0         0 return 1;
71             }
72             }
73              
74              
75             #==============================================================================#
76              
77             =item $ed->update(%args);
78              
79             Updates your EasyDNS dynamic DNS records. Valid C<%args> are:
80              
81             =over 8
82              
83             C - Your EasyDNS login name. This is required.
84              
85             C - The corresponding password. This is required.
86              
87             C - The full host being updated. This is required.
88              
89             C - The root domain of your hostname, for example if your hostname is
90             "example.co.uk" you should set "tld" to "co.uk".
91              
92             C - The IP address of the client to be updated. Use "0.0.0.0" to set
93             record to an offline state (sets record to "offline.easydns.com"). This
94             defaults to the IP address of the incoming connection (handy if you are
95             being natted).
96              
97             C - Use this parameter as the MX handler for the domain being updated,
98             it defaults to preference 5.
99              
100             C - Values are either C<"YES"> or C<"NO">, if C<"YES"> we set smtp.easydns.com
101             to be a backup mail spool for domain being updated at preference 100.
102              
103             C - Values are either C<"ON"> or C<"OFF">, if C<"ON"> sets a wildcard
104             host record for the domain being updated equal to the IP address specified
105             in C.
106              
107             C - Values are either C<1> or C<0>. If C<1>, then SSL https is used to connect
108             to EasyDNS. The SSL connection has the big advantage
109             that your passwords are not passed in plain-text accross the internet. Secure is on by
110             default if Crypt::SSLeay is installed. A warning will be generated if it's not
111             installed, unless you set C 0>. If you set C 1> and the module is
112             unavailable, the module will C.
113              
114             =back
115              
116             The function returns C of success. On failure it returns C and
117             sets C<$@>.
118              
119             =cut
120              
121             sub update {
122 1     1 1 1560 my ($obj,%args) = @_;
123              
124 1         3 my %get;
125 1         7 while (my ($k,$v) = each %args) {
126 3 100       12 if ( $k eq "username" ) { $obj->{"username"} = $v }
  1 100       7  
    50          
    0          
    0          
    0          
    0          
    0          
    0          
127 1         5 elsif ( $k eq "password" ) { $obj->{"password"} = $v }
128 1         6 elsif ( $k eq "hostname" ) { $get{hostname} = $v }
129 0         0 elsif ( $k eq "tld" ) { $get{tld} = $v }
130 0         0 elsif ( $k eq "myip" ) { $get{myip} = $v }
131 0         0 elsif ( $k eq "mx" ) { $get{mx} = $v }
132 0         0 elsif ( $k eq "backmx" ) { $get{backmx} = $v }
133 0         0 elsif ( $k eq "wildcard" ) { $get{wildcard} = $v }
134 0         0 elsif ( $k eq "secure" ) { $obj->{"secure"} = $v }
135 0         0 else { carp "update(): Bad argument $k" }
136             }
137              
138 1 50       4 croak "update(): Argument 'username' is required"
139             unless defined $obj->{"username"};
140              
141 1 50       4 croak "update(): Argument 'password' is required"
142             unless defined $obj->{"password"};
143              
144 1 50       4 croak "update(): Argument 'hostname' is required"
145             unless defined $args{"hostname"};
146              
147 1 50       9 if (defined $obj->{"secure"}) {
148 0 0 0     0 if ($obj->{"secure"} && ! _can_do_https()) {
149 0         0 croak "Can't run in secure mode - try installing Crypt::SSLeay"
150             }
151             } else {
152 1 50       3 if (_can_do_https()) {
153 0         0 $obj->{"secure"} = 1;
154             } else {
155 1         216 carp "** USING INSECURE MODE - PLEASE READ THE DOCUMENTATION **\n";
156 1         228 $obj->{"secure"} = 0;
157             }
158             }
159              
160             ## Make the GET request URL.
161              
162 1 50       8 my $proto = $obj->{"secure"} ? "https://" : "http://";
163              
164 1         5 my $qry = join('&', map { escape($_)."=".escape($get{$_}) } keys %get);
  1         9  
165              
166 1         38 my $resp = $obj->request(GET $proto.URL."?".$qry);
167              
168 1 50       347705 if ($resp->is_success) {
169 1         19 chomp(my $code = $resp->content);
170 1 50       15 if ($code eq 'NOERROR') {
171 0         0 return 1;
172             } else {
173 1         3 $@ = 'easyDNS said "'.$code.'"';
174 1         34 return;
175             }
176             } else {
177 0         0 $@ = 'HTTP request failed "'.$resp->status_line.'"';
178 0         0 return;
179             }
180             }
181              
182             =item DNS::EasyDNS->get_basic_credentials();
183              
184             Since EasyDNS object is an inheritted L, it overrides
185             this UserAgent method for your convenience. It uses the credentials passed
186             in the constructor. There is no real reason to override, or call this.
187              
188             sub get_basic_credentials { ($_[0]->{"username"}, $_[0]->{"password"}) }
189              
190             =cut
191              
192 1     1 1 429609 sub get_basic_credentials { ($_[0]->{"username"}, $_[0]->{"password"}) }
193              
194             #==============================================================================#
195              
196             =back
197              
198             =head1 NOTES
199              
200             There are some example scripts in the C directory of the module
201             distribution. These are designed to run out of cron (or similar). You
202             should not run them to often to avoid overloading the EasyDNS servers (in fact
203             EasyDNS will not respond to similar reqests less that 10 minutes apart). Ideally
204             your code should cache the existing value for your IP, and only update
205             EasyDNS when it changes.
206              
207             =head1 BUGS
208              
209             None known
210              
211             =head1 AUTHOR
212              
213             This module is Copyright (c) 2003-2006 Gavin Brock gbrock@cpan.org. All rights
214             reserved. This program is free software; you can redistribute it and/or
215             modify it under the same terms as Perl itself.
216              
217             For more information about the EasyDNS services please visit
218             http://www.easydns.com/. This module is not written nor supported by
219             EasyDNS Technologies Inc., however the code (and much of the documentation) is
220             based on the Update API as provided by EasyDNS.
221              
222             =head1 SEE ALSO
223              
224             L
225              
226             =cut
227              
228             #
229             # That's all folks..
230             #==============================================================================#
231              
232             1;