1package Net::Domain::ExpireDate;
2
3use strict;
4use Time::Piece;
5use Net::Whois::Raw;
6use Encode;
7use utf8;
8
9use constant FLG_EXPDATE => 0b0001;
10use constant FLG_CREDATE => 0b0010;
11use constant FLG_ALL     => 0b1111;
12
13use constant ONE_DAY => 86_400;
14use constant ONE_YEAR => 31_556_930; # 365.24225 days
15
16our @EXPORT = qw(
17    expire_date expdate_int expdate_fmt credate_fmt domain_dates domdates_fmt
18    $USE_REGISTRAR_SERVERS
19);
20
21our $VERSION = '1.20';
22
23our $USE_REGISTRAR_SERVERS;
24our $CACHE_DIR;
25our $CACHE_TIME;
26
27$USE_REGISTRAR_SERVERS = 0;
28# 0 - make queries to registry server
29# 1 - make queries to registrar server
30# 2 - make queries to registrar server and in case of fault make query to registry server
31
32# for Net::Whois::Raw
33$Net::Whois::Raw::OMIT_MSG = 2;
34$Net::Whois::Raw::CHECK_FAIL = 3;
35
36sub expire_date {
37    my ( $domain, $format ) = @_;
38
39    if ( $USE_REGISTRAR_SERVERS == 0 ) {
40        return _expire_date_query( $domain, $format, 1 );
41    }
42    elsif ( $USE_REGISTRAR_SERVERS == 1 ) {
43        return _expire_date_query( $domain, $format, 0 );
44    }
45    elsif ( $USE_REGISTRAR_SERVERS == 2 ) {
46        return _expire_date_query( $domain, $format, 0 )
47            || _expire_date_query( $domain, $format, 1 );
48    }
49}
50
51sub domain_dates {
52    my ( $domain, $format ) = @_;
53
54    _config_netwhoisraw();
55
56    return  unless $domain =~ /(.+?)\.([^.]+)$/;
57    my ( $name, $tld ) = ( lc $1 , lc $2 );
58
59    my $whois;
60
61    if ( $USE_REGISTRAR_SERVERS == 0 ) {
62        $whois = Net::Whois::Raw::whois( $domain, undef, 'QRY_FIRST' );
63    }
64    elsif ( $USE_REGISTRAR_SERVERS == 1 ) {
65        $whois = Net::Whois::Raw::whois( $domain, undef, 'QRY_LAST' );
66    }
67    elsif ( $USE_REGISTRAR_SERVERS == 2 ) {
68        $whois = Net::Whois::Raw::whois( $domain, undef, 'QRY_LAST'  )
69              || Net::Whois::Raw::whois( $domain, undef, 'QRY_FIRST' )
70    }
71
72    return domdates_fmt( $whois, $tld, $format )  if $format;
73
74    return domdates_int( $whois, $tld );
75}
76
77sub _expire_date_query {
78    my ( $domain, $format, $via_registry ) = @_;
79
80    _config_netwhoisraw();
81
82    return  unless $domain =~ /(.+?)\.([^.]+)$/;
83    my ( $name, $tld ) = ( lc $1, lc $2 );
84
85    my $whois = Net::Whois::Raw::whois( $domain, undef, $via_registry ? 'QRY_FIRST' : 'QRY_LAST' );
86
87    return expdate_fmt( $whois, $tld, $format )  if $format;
88
89    return expdate_int( $whois, $tld );
90}
91
92sub domdates_fmt {
93    my ( $whois, $tld, $format, $flags ) = @_;
94    $format ||= '%Y-%m-%d';
95
96    my ( $cre_date, $exp_date, $fre_date ) = domdates_int( $whois, $tld, $flags );
97
98    local $^W = 0;  # prevent warnings
99
100    $cre_date = $cre_date ? $cre_date->strftime( $format ) : '';
101    $exp_date = $exp_date ? $exp_date->strftime( $format ) : '';
102    $fre_date = $fre_date ? $fre_date->strftime( $format ) : '';
103
104    return $cre_date, $exp_date, $fre_date;
105}
106
107sub expdate_fmt {
108    my ( $whois, $tld, $format ) = @_;
109
110    my ( $cre_date, $exp_date ) = domdates_fmt( $whois, $tld, $format, FLG_EXPDATE );
111
112    return $exp_date;
113}
114
115sub credate_fmt {
116    my ( $whois, $tld, $format ) = @_;
117
118    my ( $cre_date, $exp_date ) = domdates_fmt( $whois, $tld, $format, FLG_CREDATE );
119
120    return $cre_date;
121}
122
123sub domdates_int {
124    my ( $whois, $tld, $flags ) = @_;
125    $tld ||= 'com';
126    $flags ||= FLG_ALL;
127
128    if ( _isin( $tld, [ qw( ru su xn--p1ai pp.ru net.ru org.ru ) ] ) ) {
129        return _dates_int_ru( $whois );
130    }
131
132    if ( $tld eq 'jp' ) {
133        $whois = eval { Encode::decode( 'UTF-8', $whois ) } || $whois;
134    }
135
136    my $expdate = $flags & FLG_EXPDATE ? _expdate_int_cno( $whois ) : undef;
137    my $credate = $flags & FLG_CREDATE ? _credate_int_cno( $whois ) : undef;
138
139    return $credate, $expdate;
140}
141
142sub expdate_int {
143    my ( $whois, $tld ) = @_;
144
145    my ( $cre_date, $exp_date, $fre_date ) = domdates_int( $whois, $tld, 1 );
146
147    return $exp_date;
148}
149
150sub decode_date {
151    my ( $date, $format) = @_;
152    return  unless $date;
153    $format ||= '%Y-%m-%d';
154
155    my $t = eval { Time::Piece->strptime( $date, $format ) };
156
157    if ( $@ ) {
158        warn "Can't parse date: ($date, $format)";
159        return;
160    }
161
162    return $t;
163}
164
165# --- internal functions ----
166
167sub _config_netwhoisraw {
168    $Net::Whois::Raw::CACHE_DIR  = $CACHE_DIR   if $CACHE_DIR ;
169    $Net::Whois::Raw::CACHE_TIME = $CACHE_TIME  if $CACHE_TIME;
170}
171
172# extract expiration date from whois output
173sub _expdate_int_cno {
174    my ( $whois ) = @_;
175    return  unless $whois;
176
177    # $Y - The year, including century
178    # $y - The year within century (0-99)
179    # $m - The month number (1-12)
180    # $b - The month name
181    # $d - The day of month (1-31)
182    my ( $rulenum, $Y, $y, $m, $b, $d );
183
184    # [whois.networksolutions.com]	Record expires on 27-Apr-2011.
185    # [whois.opensrs.net]
186    # [whois.namesdirect.com]
187    # [whois.dotregistrar.com]
188    # [whois.domaininfo.com]		Domain expires: 24 Oct 2010
189    # [whois.ibi.net]			Record expires on........: 03-Jun-2005 EST.
190    # [whois.gkg.net]			Expires on..............: 24-JAN-2003
191    # [whois.enom.com]			Expiration date: 11 Jun 2005 14:22:48
192    if ( $whois =~ m/\sexpir.+?:?\s+(\d{2})[- ](\w{3})[- ](\d{4})/is ) {
193        $rulenum = 1.1;	$d = $1; $b = $2; $Y = $3;
194    # [whois.discount-domain.com]	Expiration Date: 02-Aug-2003 22:07:21
195    # [whois.publicinterestregistry.net] Expiration Date:03-Mar-2004 05:00:00 UTC
196    # [whois.crsnic.net]		Expiration Date: 21-sep-2004
197    # [whois.nic.uk]			Renewal Date:   23-Jan-2006
198    # [whois.aero]			    Expires On:18-May-2008 01:53:51 UTC
199    # [whois.nic.me]			Domain Expiration Date:28-Aug-2012 17:57:10 UTC
200    # [whois.domainregistry.ie]
201    } elsif ( $whois =~ m/(?:Expi\w+|Renewal) (?:Date|On):\s*(\d{2})-(\w{3})-(\d{4})/is ) {
202        $rulenum = 1.2;	$d = $1; $b = $2; $Y = $3;
203    # [whois.bulkregister.com]		Record expires on 2003-04-25
204    # [whois.bulkregister.com]		Record will be expiring on date: 2003-04-25
205    # [whois.bulkregister.com]		Record expiring on -  2003-04-25
206    # [whois.bulkregister.com]		Record will expire on -  2003-04-25
207    # [whois.bulkregister.com]		Record will be expiring on date: 2003-04-25
208    # [whois.eastcom.com]
209    # [whois.corenic.net]		Record expires:       2003-07-29 10:45:05 UTC
210    # [whois.gandi.net]			expires:        2003-05-21 10:09:56
211    # [whois.dotearth.com]		Record expires on:       2010-04-07 00:00:00.0 ET
212    # [whois.names4ever.com]		Record expires on 2012-07-15 10:23:10.000
213    # [whois.OnlineNIC.com]		Record expired on 2008/8/26
214    # [whois.ascio.net]			Record expires:           2003-03-12 12:16:45
215    # [whois.totalnic.net]		Record expires on 2010-04-24 16:03:20+10
216    # [whois.signaturedomains.com]	Expires on: 2003-11-05
217    # [whois.1stdomain.net]		Domain expires: 2007-01-20.
218    # [whois.easyspace.com]
219    # [whois.centralnic.com]    Expiration Date:2014-05-13T23:59:59.0Z
220    } elsif ( $whois =~ m&(?:Record |Domain )?(?:will )?(?:be )?expir(?:e|ed|es|ing|ation)(?: on)?(?: date)?\s*[-:]?\s*(\d{4})[/-](\d{1,2})[/-](\d{1,2})&is ) {
221        $rulenum = 2.1;	$Y = $1; $m = $2; $d = $3;
222    # [whois.InternetNamesWW.com]	Expiry Date.......... 2009-06-16
223    # [whois.aitdomains.com]		Expire on................ 2002-11-05 16:42:41.000
224    # [whois.yesnic.com]		    Valid Date     2010-11-02 05:21:35 EST
225    # [whois.enetregistry.net]		Expiration Date     : 2002-11-19 04:18:25-05
226    # [whois.enterprice.net]		Date of expiration  : 2003-05-28 11:50:58
227    # [nswhois.domainregistry.com]	Expires on..............: 2006-07-24
228    # [whois.cira.ca]			    Renewal date:   2006/10/27
229    # [whois.cira.ca]               Expiry date:           2015/12/27
230    # [whois.kr]                    Expiration Date             : 2013. 03. 02.
231    # [whois.nic.ir]                expire-date:   2015-05-26
232    # [whois.nic.io]                Expiry : 2017-01-25
233    } elsif ( $whois =~ m&(?:Expiry|Expiry Date|expire-date|Expire(?:d|s)? on|Valid[ -][Dd]ate|[Ee]xpiration [Dd]ate|Date of expiration|Renewal[- ][Dd]ate)(?:\.*|\s*):?\s+(\d{4})[/.-] ?(\d{2})[/.-] ?(\d{2})&si ) {
234        $rulenum = 2.2;	$Y = $1; $m = $2; $d = $3;
235    # [whois.oleane.net]		expires:        20030803
236    # [whois.nic.it]			expire:      20051011
237    } elsif ( $whois =~ m/expires?:\s+(\d{4})(\d{2})(\d{2})/is ) {
238        $rulenum = 2.3;	$Y = $1; $m = $2; $d = $3;
239    # [whois.ripe.net] .FI		expires:  1.9.2007
240    # [whois.fi] .FI			expires............:  1.9.2007
241    # [whois.rnids.rs]          Expiration date: 15.09.2012 11:58:33
242    # [whois.dns.pt]            Expiration Date (dd/mm/yyyy): 31/12/2013
243    # [whois.nic.im]            Expiry Date: 28/12/2012 00:59:59
244    # [whois.isoc.org.il]       validity:     15-08-2012
245    # [whois.register.bg]       expires at: 08/01/2013 00:00:00 EET
246    } elsif ( $whois =~ m/(?:validity|Expiry Date|expires?(?:\.*)(?: at)?|expiration date(?: \(dd\/mm\/yyyy\))?):\s+(\d{1,2})[.\/-](\d{1,2})[.\/-](\d{4})/is ) {
247        $rulenum = 2.4; $Y = $3; $m = $2; $d = $1;
248    # [whois.dotster.com]		Expires on: 12-DEC-05
249    # [whois for domain rosemount.com] Expires on..............: 26-Oct-15
250    # [whois.godaddy.com]		Expires on: 02-Mar-16
251    } elsif ( $whois =~ m/Expires on\.*: (\d{2})-(\w{3})-(\d{2})/s ) {
252        $rulenum = 3;	$d = $1; $b = $2; $y = $3;
253    # [whois.register.com]		Expires on..............: Tue, Aug 04, 2009
254    # [whois.registrar.aol.com]	Expires on..............: Oct  5 2002 12:00AM
255    # [whois.itsyourdomain.com]	Record expires on March 06, 2011
256    # [whois.doregi.com]		Record expires on.......: Oct  28, 2011
257    # [www.nic.ac]		        Expires : January 27 2019.
258    # [whois.isnic.is]          expires:      September  5 2012
259    } elsif ( $whois =~ m/(?:Record )?expires(?: on)?\.* ?:? +(?:\w{3}, )?(\w{3,9})\s{1,2}(\d{1,2}),? (\d{4})/is ) {
260        $rulenum = 4.1;	$b = $1; $d = $2; $Y = $3;
261    # [whois.domainpeople.com]		Expires on .............WED NOV 16 09:09:52 2011
262    # [whois.e-names.org]		Expires after:   Mon Jun  9 23:59:59 2003
263    # [whois.corporatedomains.com]	Created on..............: Mon, Nov 12, 2007
264    } elsif ( $whois =~ m/(?:Created|Expires) (?:on|after)\s?\.*:?\s*\w{3},? (\w{3})\s{1,2}(\d{1,2})(?: \d{2}:\d{2}:\d{2})? (\d{4})?/is ) {
265        $rulenum = 4.2;	$b = $1; $d = $2; $Y = $3;
266    # [whois.enom.com]			Expiration date: Fri Sep 21 2012 13:45:09
267    # [whois.enom.com]			Expires: Fri Sep 21 2012 13:45:09
268    # [whois.neulevel.biz]		Domain Expiration Date: Fri Mar 26 23:59:59 GMT 2004
269    } elsif ( $whois =~ m/(?:Domain )?(?:Expires|Expiration Date):\s+\w{3} (\w{3}) (\d{2}) (?:\d{2}:\d{2}:\d{2} \w{3}(?:[-+]\d{2}:\d{2})? )(\d{4})/is ) {
270        $rulenum = 4.3; $b = $1; $d = $2; $Y = $3;
271    # [rs.domainbank.net]		Record expires on 10-05-2003 11:21:25 AM
272    # [whois.psi-domains.com]
273    # [whois.namesecure.com]		Expires on 10-09-2011
274    # [whois.catalog.com]		Record Expires on 08-24-2011
275    } elsif ( $whois =~ m&expires.+?(\d{2})-(\d{2})-(\d{4})&is ) {
276        $rulenum = 5.1;	$m = $1; $d = $2; $Y = $3;
277    # [whois.stargateinc.com]		Expiration: 6/3/2004
278    # [whois.bookmyname.com]		Expires on 11/26/2007 23:00:00
279    } elsif ( $whois =~ m&(?:Expiration|Expires on):? (\d{1,2})[-/](\d{1,2})[-/](\d{4})&is ) {
280        $rulenum = 5.2;	$m = $1; $d = $2; $Y = $3;
281    # [whois.belizenic.bz]		Expiration Date..: 15-01-2005 12:00:00
282    } elsif ( $whois =~ m&Expiration Date.+?(\d{2})-(\d{2})-(\d{4}) \d{2}:\d{2}:\d{2}&is ) {
283        $rulenum = 5.3;	$d = $1; $m = $2; $Y = $3;
284    # edit for .uk domains: Adam McGreggor <cpan[...]amyl.org.uk>;
285    # kudos on a typo to <ganesh[...]urchin.earth.li>, via irc.mysociety.org
286    # [whois.nic.uk] Registered on: 21-Oct-2003
287    } elsif ( $whois =~ m&Registered on.+?(\d{2})-(\w{3})-(\d{4})&is ) {
288        $rulenum = 5.4; $d = $1; $b = $2; $Y = $3;
289    # [whois.nordnet.net]		Record expires on 2010-Apr-03
290    # [whois.nic.nu]			Record created on 1999-Apr-5.
291    # [whois.alldomains.com]		Expires on..............: 2006-Jun-12
292    } elsif ( $whois =~ m/(?:Record |Domain )?expires on\.*:? (\d{4})-(\w{3})-(\d{1,2})/is ) {
293        $rulenum = 6;	$Y = $1; $b = $2; $d = $3;
294    # [whois.enom.com]			Expiration date: 09/21/03 13:45:09
295    } elsif ( $whois =~ m|Expiration date: (\d{2})/(\d{2})/(\d{2})|s ) {
296        $rulenum = 7;	$m = $1; $d = $2; $y = $3;
297    } elsif ( $whois =~ m/Registered through- (\w{3}) (\w{3}) (\d{2}) (\d{4})/is ) {
298        $rulenum = 7.1; $b = $2; $d = $3; $Y = $4;
299    } elsif ( $whois =~ m|Expires: (\d{2})/(\d{2})/(\d{2})|is ) {
300        $rulenum = 7.2;	$m = $1; $d = $2; $y = $3;
301    } elsif ( $whois =~ m|Registered through- (\d{2})/(\d{2})/(\d{2})|is ) {
302        $rulenum = 7.3; $m = $1; $d = $2; $y = $3;
303    # [whois.jprs.jp]                   [有効期限]                      2006/12/31
304    } elsif ( $whois =~ m{ \[有効期限\] \s+ ( \d{4} ) / ( \d{2} ) / ( \d{2} )}sx ) {
305        $rulenum = 7.4; $Y = $1; $m = $2; $d = $3;
306    }
307    # [whois.ua]			status:     OK-UNTIL 20121122000000
308    elsif ( $whois =~ m|status:\s+OK-UNTIL (\d{4})(\d{2})(\d{2})\d{6}|s ) {
309        $rulenum = 7.5; $Y = $1; $m = $2; $d = $3;
310    }
311	# [whois.fi
312
313
314    unless ( $rulenum ) {
315        warn "Can't recognise expiration date format: $whois\n";
316        return;
317    }
318    else {
319        # warn "rulenum: $rulenum\n";
320    }
321
322    my $fstr = '';
323    my $dstr = '';
324    $fstr .= $Y ? '%Y ' : '%y ';
325    $dstr .= $Y ? "$Y " : "$y ";
326
327    if ( $b && length $b > 3 ) {
328        $fstr .= '%B ';
329    }
330    elsif ( $b && length $b == 3 ) {
331        $fstr .= '%b ';
332    }
333    else {
334        $fstr .= '%m ';
335    }
336
337    $dstr .= $b ? "$b " : "$m ";
338
339    $fstr .= '%d';
340    $dstr .= $d;
341
342    return decode_date( $dstr, $fstr );
343}
344
345# extract creation date from whois output
346sub _credate_int_cno {
347    my ( $whois ) = @_;
348    return  unless $whois;
349
350    # $Y - The year, including century
351    # $y - The year within century (0-99)
352    # $m - The month number (1-12)
353    # $b - The month name
354    # $d - The day of month (1-31)
355    my ( $rulenum, $Y, $y, $m, $b, $d );
356    # [whois.crsnic.net]		Creation Date: 06-sep-2000
357    # [whois.afilias.info]		Created On:31-Jul-2001 08:42:21 UTC
358    # [whois.enom.com]			Creation date: 11 Jun 2004 14:22:48
359    # [whois for domain ibm.com] Record created on 19-Mar-1986.
360    # [whois.nic.me]		Domain Create Date:28-Aug-2008 17:57:10 UTC
361    if ( $whois =~ m/Creat(?:ion|ed On|e)[^:]*?:?\s*(\d{2})[- ](\w{3})[- ](\d{4})/is ) {
362        $rulenum = 1.2;	$d = $1; $b = $2; $Y = $3;
363    # [whois.nic.name]			Created On: 2002-02-08T14:56:54Z
364    # [whois.worldsite.ws]		Domain created on 2002-10-29 03:54:36
365    # [..cn]				Registration Date: 2003-03-19 08:06
366    } elsif ( $whois =~ m/(?:Creat.+?|Registration Date):?\s*?(\d{4})[\/-](\d{1,2})[\/-](\d{1,2})/is ) {
367        $rulenum = 2.1;	$Y = $1; $m = $2; $d = $3;
368	# created: 16.12.2006
369    # created............: 16.12.2006
370	# created: 1.1.2006
371     } elsif ( $whois =~ m/(?:created|registered)(?:\.*):\s+(\d{1,2})[-.](\d{1,2})[-.](\d{4})/is ) {
372         $rulenum = 2.2;        $Y = $3; $m = $2; $d = $1;
373    # [whois.org.ru] created: 2006.12.16
374    } elsif ( $whois =~ m/(?:created|registered):\s+(\d{4})[-.](\d{2})[-.](\d{2})/is ) {
375        $rulenum = 2.3;	$Y = $1; $m = $2; $d = $3;
376    # [whois.nic.it]			created:     20000421
377    } elsif ( $whois =~ m/created?:\s+(\d{4})(\d{2})(\d{2})/is ) {
378        $rulenum = 2.4;	$Y = $1; $m = $2; $d = $3;
379    # [whois.relcom.net]		changed:      support@webnames.ru 20030815
380    } elsif ( $whois =~ m/changed:.+?(\d{4})(\d{2})(\d{2})/is ) {
381        $rulenum = 2.5;	$Y = $1; $m = $2; $d = $3;
382    # [whois.tv]			Record created on Feb 21 2001.
383    } elsif ( $whois =~ m/Creat.+?:?\s*(?:\w{3}, )?(\w{3,9})\s{1,2}(\d{1,2}),? (\d{4})/is ) {
384        $rulenum = 4.1;	$b = $1; $d = $2; $Y = $3;
385    # [whois.dns.be]			Registered:  Wed Jan 17 2001
386    } elsif ( $whois =~ m/Regist.+?:\s*\w{3} (\w{3})\s+(\d{1,2}) (?:\d{2}:\d{2}:\d{2} )?(\d{4})/is ) {
387        $rulenum = 4.2;	$b = $1; $d = $2; $Y = $3;
388    # [whois.whois.neulevel.biz]	Domain Registration Date: Wed Mar 27 00:01:00 GMT 2002
389    } elsif ( $whois =~ m/Registration.*?:\s+\w{3} (\w{3}) (\d{2}) (?:\d{2}:\d{2}:\d{2} \w{3}(?:[-+]\d{2}:\d{2})? )?(\d{4})/is ) {
390        $rulenum = 4.3; $b = $1; $d = $2; $Y = $3;
391    } elsif ( $whois =~ m&created.+?(\d{2})-(\d{2})-(\d{4})&is ) {
392        $rulenum = 5.1;	$m = $1; $d = $2; $Y = $3;
393    # [whois.belizenic.bz]		Creation Date....: 15-01-2003 05:00:00
394    } elsif ( $whois =~ m&Creation Date.+?(\d{2})-(\d{2})-(\d{4}) \d{2}:\d{2}:\d{2}&is ) {
395        $rulenum = 5.3;	$d = $1; $m = $2; $Y = $3;
396    # [whois.jprs.jp]                   [登録年月日]                    2001/04/23
397    } elsif ( $whois =~ m{ \[登録年月日\] \s+ ( \d{4} ) / ( \d{2} ) / ( \d{2} ) }sx ) {
398        $rulenum = 7.4; $Y = $1; $m = $2; $d = $3;
399    # [whois.ua]			created:    0-UANIC 20050104013013
400    } elsif ( $whois =~ m|created:\s+0-UANIC (\d{4})(\d{2})(\d{2})\d{6}|s ) {
401        $rulenum = 7.5; $Y = $1; $m = $2; $d = $3;
402    } else {
403        warn "Can't recognise creation date format\n";
404        return;
405    }
406
407    my $fstr = '';
408    my $dstr = '';
409    $fstr .= $Y ? '%Y ' : '%y ';
410    $dstr .= $Y ? "$Y " : "$y ";
411
412    if ( $b && length $b > 3 ) {
413        $fstr .= '%B ';
414    }
415    elsif ( $b && length $b == 3 ) {
416        $fstr .= '%b ';
417    }
418    else {
419        $fstr .= '%m ';
420    }
421
422    $dstr .= $b ? "$b " : "$m ";
423
424    $fstr .= '%d';
425    $dstr .= $d;
426
427    return decode_date( $dstr, $fstr );
428}
429
430# extract creation/expiration dates from whois output for .ru, .su, .pp.ru, .net.ru, .org.ru, .рф domains
431sub _dates_int_ru {
432    my ( $whois ) = @_;
433    return  unless $whois;
434
435    my ( $reg_till, $free_date, $created );
436
437    $reg_till  = $1  if $whois =~ /reg-till:\s*(.+?)\n/s     ;
438    $reg_till  = $1  if $whois =~ /payed-till:\s*(.+?)\n/s   ;
439    $reg_till  = $1  if $whois =~ /paid-till:\s*(.+?)\n/s    ;
440    $free_date = $1  if $whois =~ /free-date:\s*(.+?)\n/s    ;
441    $created   = $1  if $whois =~ /created:\s+(.+?)\n/s  ;
442    $reg_till  = $1  if $whois =~ /Delegated till\s*(.+?)\n/s;
443
444    my $format = '%Y-%m-%dT%H:%M:%SZ';
445    # OLD format date
446    if (
447        $created && $created     =~ /\./
448          ||
449        $reg_till && $reg_till   =~ /\./
450          ||
451        $free_date && $free_date =~ /\./
452    ) {
453
454      $format = '%Y-%m-%d';
455
456      $reg_till  =~ tr/./-/  if $reg_till;
457      $free_date =~ tr/./-/  if $free_date;
458      $created   =~ tr/./-/  if $created;
459    }
460
461    if ( $created ) {
462        # Guess reg-till date
463        $created = decode_date( $created, $format );
464
465        my $t = $created;
466
467        if ( $t && !$reg_till && !$free_date ) {
468            $t += 0;
469            while ( $t < localtime() ) {
470                $t += ONE_YEAR + ( $t->is_leap_year() ? 1 : 0 );
471            }
472            $reg_till = $t->strftime( $format );
473        }
474    }
475
476    unless ( $reg_till || $free_date ) {
477        warn "Can't obtain expiration date from ($reg_till)\n";
478        return;
479    }
480
481    $reg_till  = decode_date( $reg_till,  $format );
482    $free_date = decode_date( $free_date, '%Y-%m-%d' );
483
484    if ( !$reg_till && $free_date ) {
485        $reg_till = $free_date - 33 * ONE_DAY;
486    }
487
488    return $created, $reg_till, $free_date;
489}
490
491sub _isin {
492    my ( $val, $arr ) = @_;
493    return 0  unless $arr;
494
495    for ( @$arr ) {
496        return 1  if $_ eq $val;
497    }
498
499    return 0;
500}
501
502sub import {
503    my $mypkg = shift;
504    my $callpkg = caller;
505
506    no strict 'refs';
507
508    # export subs
509    *{ "$callpkg\::$_" } = \&{ "$mypkg\::$_" }  for @EXPORT, @_;
510}
511
512
5131;
514__END__
515
516=head1 NAME
517
518Net::Domain::ExpireDate -- obtain expiration date of domain names
519
520=head1 SYNOPSIS
521
522 use Net::Domain::ExpireDate;
523
524 $expiration_obj = expire_date( 'microsoft.com' );
525 $expiration_str  = expire_date( 'microsoft.com', '%Y-%m-%d' );
526 $expiration_obj = expdate_int( $whois_text, 'com' );
527 $expiration_str  = expdate_fmt( $whois_text, 'ru', '%Y-%m-%d' );
528
529 ($creation_obj, $expiration_obj) = domain_dates( 'microsoft.com' );
530 ($creation_str, $expiration_str) = domain_dates( 'microsoft.com', '%Y-%m-%d' );
531 ($creation_obj, $expiration_obj) = domdates_int( $whois_text, 'com' );
532
533=head1 ABSTRACT
534
535Net::Domain::ExpireDate gets WHOIS information of given domain using
536Net::Whois::Raw and tries to obtain expiration date of domain.
537Unfortunately there are too many different whois servers which provides
538whois info in very different formats.
539Net::Domain::ExpireDate knows more than 40 different formats of
540expiration date representation provided by different servers (almost
541all gTLD registrars and some ccTLD registrars are covered).
542Now obtaining of domain creation date is also supported.
543
544"$date" in synopsis is an object of type L<Time::Piece>.
545
546=head1 FUNCTIONS
547
548=over 4
549
550=item expire_date( DOMAIN [,FORMAT] )
551
552Returns expiration date of C<DOMAIN>.
553Without C<FORMAT> argument returns L<Time::Piece> object.
554With C<FORMAT> argument returns date formatted using C<FORMAT> template.
555See L<strftime> man page for C<FORMAT> specification.
556
557=item expdate_int( WHOISTEXT [,TLD] )
558
559Extracts expiration date of domain in TLD from C<WHOISTEXT>.
560If no TLD is given 'com' is the default. There is no
561distinction between 'com' or 'net' TLDs in this function.
562Also 'org', 'biz', 'cz', 'info', 'us', 'uk', 'ru' and 'su' TLDs are supported.
563Returns L<Time::Piece> object.
564
565With C<FORMAT> argument returns date formatted using C<FORMAT> template
566(see L<strftime> man page for C<FORMAT> specification)
567
568=item expdate_fmt( WHOISTEXT [,TLD [,FORMAT]]  )
569
570Similar to expdate_int except that output value is formatted date.
571If no C<FORMAT> specified, '%Y-%m-%d' is assumed.
572See L<strftime> man page for C<FORMAT> specification.
573
574=item domain_dates( DOMAIN [,FORMAT] )
575
576Returns list of two values -- creation and expiration date of C<DOMAIN>.
577Without C<FORMAT> argument returns L<Time::Piece> objects.
578With C<FORMAT> argument dates are formatted using C<FORMAT> template.
579See L<strftime> man page for C<FORMAT> specification.
580
581=item domdates_int( WHOISTEXT [,TLD [,FLAGS]] )
582
583Returns list of three values -- creation, expiration and
584free date of domain extracted from C<WHOISTEXT>.
585If no TLD is given 'com' is the default. There is no
586distinction between 'com' or 'net' TLDs in this function.
587Also 'org', 'biz', 'cz', 'info', 'us', 'ru' and 'su' TLDs are supported.
588Returns L<Time::Piece> object.
589
590=item domdates_fmt( WHOISTEXT [,TLD [,FORMAT [,FLAGS]]] )
591
592The same as domdates_int, except it returns formatted results
593instead of Time::Piece objects.
594
595
596=back
597
598=head1 AUTHOR
599
600Walery Studennikov, <despair@cpan.org>
601
602=head1 SEE ALSO
603
604L<Net::Whois::Raw>, L<Time::Piece>.
605
606=cut
607