File Coverage

lib/Net/Domain/ExpireDate.pm
Criterion Covered Total %
statement 248 308 80.5
branch 137 174 78.7
condition 39 56 69.6
subroutine 25 26 96.1
pod 6 8 75.0
total 455 572 79.5


line stmt bran cond sub pod time code
1             package Net::Domain::ExpireDate;
2              
3 1     1   16186 use strict;
  1         3  
  1         34  
4 1     1   688 use Time::Piece;
  1         11775  
  1         6  
5 1     1   855 use Net::Whois::Raw;
  1         82554  
  1         7  
6 1     1   47 use Encode;
  1         1  
  1         70  
7 1     1   4 use utf8;
  1         1  
  1         6  
8              
9 1     1   20 use constant FLG_EXPDATE => 0b0001;
  1         1  
  1         171  
10 1     1   6 use constant FLG_CREDATE => 0b0010;
  1         2  
  1         64  
11 1     1   6 use constant FLG_ALL => 0b1111;
  1         2  
  1         66  
12              
13 1     1   7 use constant ONE_DAY => 86_400;
  1         1  
  1         64  
14 1     1   6 use constant ONE_YEAR => 31_556_930; # 365.24225 days
  1         2  
  1         3529  
15              
16             our @EXPORT = qw(
17             expire_date expdate_int expdate_fmt credate_fmt domain_dates domdates_fmt
18             $USE_REGISTRAR_SERVERS
19             );
20              
21             our $VERSION = '1.18';
22              
23             our $USE_REGISTRAR_SERVERS;
24             our $CACHE_DIR;
25             our $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              
36             sub expire_date {
37 4     4 1 12 my ( $domain, $format ) = @_;
38              
39 4 50       35 if ( $USE_REGISTRAR_SERVERS == 0 ) {
    50          
    50          
40 0         0 return _expire_date_query( $domain, $format, 1 );
41             }
42             elsif ( $USE_REGISTRAR_SERVERS == 1 ) {
43 0         0 return _expire_date_query( $domain, $format, 0 );
44             }
45             elsif ( $USE_REGISTRAR_SERVERS == 2 ) {
46 4   33     14 return _expire_date_query( $domain, $format, 0 )
47             || _expire_date_query( $domain, $format, 1 );
48             }
49             }
50              
51             sub domain_dates {
52 5     5 1 14 my ( $domain, $format ) = @_;
53              
54 5         19 _config_netwhoisraw();
55              
56 5 50       43 return unless $domain =~ /(.+?)\.([^.]+)$/;
57 5         25 my ( $name, $tld ) = ( lc $1 , lc $2 );
58              
59 5         10 my $whois;
60              
61 5 100       31 if ( $USE_REGISTRAR_SERVERS == 0 ) {
    50          
    50          
62 1         6 $whois = Net::Whois::Raw::whois( $domain, undef, 'QRY_FIRST' );
63             }
64             elsif ( $USE_REGISTRAR_SERVERS == 1 ) {
65 0         0 $whois = Net::Whois::Raw::whois( $domain, undef, 'QRY_LAST' );
66             }
67             elsif ( $USE_REGISTRAR_SERVERS == 2 ) {
68 4   33     19 $whois = Net::Whois::Raw::whois( $domain, undef, 'QRY_LAST' )
69             || Net::Whois::Raw::whois( $domain, undef, 'QRY_FIRST' )
70             }
71              
72 5 50       2708010 return domdates_fmt( $whois, $tld, $format ) if $format;
73              
74 0         0 return domdates_int( $whois, $tld );
75             }
76              
77             sub _expire_date_query {
78 4     4   51 my ( $domain, $format, $via_registry ) = @_;
79              
80 4         14 _config_netwhoisraw();
81              
82 4 50       33 return unless $domain =~ /(.+?)\.([^.]+)$/;
83 4         23 my ( $name, $tld ) = ( lc $1, lc $2 );
84              
85 4 50       23 my $whois = Net::Whois::Raw::whois( $domain, undef, $via_registry ? 'QRY_FIRST' : 'QRY_LAST' );
86              
87 4 50       1360767 return expdate_fmt( $whois, $tld, $format ) if $format;
88              
89 0         0 return expdate_int( $whois, $tld );
90             }
91              
92             sub domdates_fmt {
93 83     83 1 149 my ( $whois, $tld, $format, $flags ) = @_;
94 83   100     342 $format ||= '%Y-%m-%d';
95              
96 83         191 my ( $cre_date, $exp_date, $fre_date ) = domdates_int( $whois, $tld, $flags );
97              
98 83         291 local $^W = 0; # prevent warnings
99              
100 83 100       171 $cre_date = $cre_date ? $cre_date->strftime( $format ) : '';
101 83 100       1821 $exp_date = $exp_date ? $exp_date->strftime( $format ) : '';
102 83 100       3495 $fre_date = $fre_date ? $fre_date->strftime( $format ) : '';
103              
104 83         622 return $cre_date, $exp_date, $fre_date;
105             }
106              
107             sub expdate_fmt {
108 63     63 1 575 my ( $whois, $tld, $format ) = @_;
109              
110 63         112 my ( $cre_date, $exp_date ) = domdates_fmt( $whois, $tld, $format, FLG_EXPDATE );
111              
112 63         312 return $exp_date;
113             }
114              
115             sub credate_fmt {
116 10     10 0 23 my ( $whois, $tld, $format ) = @_;
117              
118 10         17 my ( $cre_date, $exp_date ) = domdates_fmt( $whois, $tld, $format, FLG_CREDATE );
119              
120 10         41 return $cre_date;
121             }
122              
123             sub domdates_int {
124 83     83 1 104 my ( $whois, $tld, $flags ) = @_;
125 83   100     225 $tld ||= 'com';
126 83   100     205 $flags ||= FLG_ALL;
127              
128 83 100       347 if ( _isin( $tld, [ qw( ru su xn--p1ai pp.ru net.ru org.ru ) ] ) ) {
129 13         33 return _dates_int_ru( $whois );
130             }
131              
132 70 100       178 if ( $tld eq 'jp' ) {
133 1   33     4 $whois = eval { Encode::decode( 'UTF-8', $whois ) } || $whois;
134             }
135              
136 70 100       270 my $expdate = $flags & FLG_EXPDATE ? _expdate_int_cno( $whois ) : undef;
137 70 100       189 my $credate = $flags & FLG_CREDATE ? _credate_int_cno( $whois ) : undef;
138              
139 70         141 return $credate, $expdate;
140             }
141              
142             sub expdate_int {
143 0     0 1 0 my ( $whois, $tld ) = @_;
144              
145 0         0 my ( $cre_date, $exp_date, $fre_date ) = domdates_int( $whois, $tld, 1 );
146              
147 0         0 return $exp_date;
148             }
149              
150             sub decode_date {
151 109     109 0 153 my ( $date, $format) = @_;
152 109 100       335 return unless $date;
153 99   50     183 $format ||= '%Y-%m-%d';
154              
155 99         112 my $t = eval { Time::Piece->strptime( $date, $format ) };
  99         368  
156              
157 99 50       5631 if ( $@ ) {
158 0         0 warn "Can't parse date: ($date, $format)";
159 0         0 return;
160             }
161              
162 99         189 return $t;
163             }
164              
165             # --- internal functions ----
166              
167             sub _config_netwhoisraw {
168 9 50   9   34 $Net::Whois::Raw::CACHE_DIR = $CACHE_DIR if $CACHE_DIR ;
169 9 50       25 $Net::Whois::Raw::CACHE_TIME = $CACHE_TIME if $CACHE_TIME;
170             }
171              
172             # extract expiration date from whois output
173             sub _expdate_int_cno {
174 60     60   93 my ( $whois ) = @_;
175 60 50       100 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 60         65 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 60 100       12994 if ( $whois =~ m/\sexpir.+?:?\s+(\d{2})[- ](\w{3})[- ](\d{4})/is ) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    100          
    100          
    50          
    50          
    50          
    100          
    50          
193 7         9 $rulenum = 1.1; $d = $1; $b = $2; $Y = $3;
  7         13  
  7         11  
  7         23  
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 2         4 $rulenum = 1.2; $d = $1; $b = $2; $Y = $3;
  2         4  
  2         2  
  2         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 21         26 $rulenum = 2.1; $Y = $1; $m = $2; $d = $3;
  21         75  
  21         35  
  21         27  
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 5         6 $rulenum = 2.2; $Y = $1; $m = $2; $d = $3;
  5         8  
  5         8  
  5         6  
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 1         2 $rulenum = 2.3; $Y = $1; $m = $2; $d = $3;
  1         2  
  1         2  
  1         2  
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 1         3 $rulenum = 2.4; $Y = $3; $m = $2; $d = $1;
  1         3  
  1         2  
  1         2  
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 1         2 $rulenum = 3; $d = $1; $b = $2; $y = $3;
  1         3  
  1         1  
  1         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 7         8 $rulenum = 4.1; $b = $1; $d = $2; $Y = $3;
  7         14  
  7         9  
  7         10  
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 2         3 $rulenum = 4.2; $b = $1; $d = $2; $Y = $3;
  2         3  
  2         3  
  2         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 2         8 $rulenum = 4.3; $b = $1; $d = $2; $Y = $3;
  2         10  
  2         8  
  2         7  
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 3         4 $rulenum = 5.1; $m = $1; $d = $2; $Y = $3;
  3         9  
  3         4  
  3         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 2         3 $rulenum = 5.2; $m = $1; $d = $2; $Y = $3;
  2         3  
  2         3  
  2         2  
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 0         0 $rulenum = 5.3; $d = $1; $m = $2; $Y = $3;
  0         0  
  0         0  
  0         0  
284             # edit for .uk domains: Adam McGreggor ;
285             # kudos on a typo to , 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 0         0 $rulenum = 5.4; $d = $1; $b = $2; $Y = $3;
  0         0  
  0         0  
  0         0  
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 3         5 $rulenum = 6; $Y = $1; $b = $2; $d = $3;
  3         8  
  3         5  
  3         5  
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 1         2 $rulenum = 7; $m = $1; $d = $2; $y = $3;
  1         2  
  1         1  
  1         2  
297             } elsif ( $whois =~ m/Registered through- (\w{3}) (\w{3}) (\d{2}) (\d{4})/is ) {
298 0         0 $rulenum = 7.1; $b = $2; $d = $3; $Y = $4;
  0         0  
  0         0  
  0         0  
299             } elsif ( $whois =~ m|Expires: (\d{2})/(\d{2})/(\d{2})|is ) {
300 0         0 $rulenum = 7.2; $m = $1; $d = $2; $y = $3;
  0         0  
  0         0  
  0         0  
301             } elsif ( $whois =~ m|Registered through- (\d{2})/(\d{2})/(\d{2})|is ) {
302 0         0 $rulenum = 7.3; $m = $1; $d = $2; $y = $3;
  0         0  
  0         0  
  0         0  
303             # [whois.jprs.jp] [有効期限] 2006/12/31
304             } elsif ( $whois =~ m{ \[有効期限\] \s+ ( \d{4} ) / ( \d{2} ) / ( \d{2} )}sx ) {
305 1         4 $rulenum = 7.4; $Y = $1; $m = $2; $d = $3;
  1         5  
  1         3  
  1         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 1         3 $rulenum = 7.5; $Y = $1; $m = $2; $d = $3;
  1         3  
  1         3  
  1         2  
310             }
311             # [whois.fi
312              
313              
314 60 50       107 unless ( $rulenum ) {
315 0         0 warn "Can't recognise expiration date format: $whois\n";
316 0         0 return;
317             }
318             else {
319             # warn "rulenum: $rulenum\n";
320             }
321              
322 60         88 my $fstr = '';
323 60         55 my $dstr = '';
324 60 100       106 $fstr .= $Y ? '%Y ' : '%y ';
325 60 100       99 $dstr .= $Y ? "$Y " : "$y ";
326              
327 60 100 100     296 if ( $b && length $b > 3 ) {
    100 66        
328 3         5 $fstr .= '%B ';
329             }
330             elsif ( $b && length $b == 3 ) {
331 21         22 $fstr .= '%b ';
332             }
333             else {
334 36         42 $fstr .= '%m ';
335             }
336              
337 60 100       132 $dstr .= $b ? "$b " : "$m ";
338              
339 60         61 $fstr .= '%d';
340 60         83 $dstr .= $d;
341              
342 60         158 return decode_date( $dstr, $fstr );
343             }
344              
345             # extract creation date from whois output
346             sub _credate_int_cno {
347 16     16   22 my ( $whois ) = @_;
348 16 50       36 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 16         17 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 16 100       1390 if ( $whois =~ m/Creat(?:ion|ed On|e)[^:]*?:?\s*(\d{2})[- ](\w{3})[- ](\d{4})/is ) {
    100          
    100          
    50          
    50          
    50          
    100          
    100          
    100          
    50          
    50          
    100          
    50          
362 3         4 $rulenum = 1.2; $d = $1; $b = $2; $Y = $3;
  3         8  
  3         6  
  3         5  
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 4         8 $rulenum = 2.1; $Y = $1; $m = $2; $d = $3;
  4         13  
  4         8  
  4         10  
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 2         4 $rulenum = 2.2; $Y = $3; $m = $2; $d = $1;
  2         5  
  2         3  
  2         4  
373             # [whois.org.ru] created: 2006.12.16
374             } elsif ( $whois =~ m/(?:created|registered):\s+(\d{4})[-.](\d{2})[-.](\d{2})/is ) {
375 0         0 $rulenum = 2.3; $Y = $1; $m = $2; $d = $3;
  0         0  
  0         0  
  0         0  
376             # [whois.nic.it] created: 20000421
377             } elsif ( $whois =~ m/created?:\s+(\d{4})(\d{2})(\d{2})/is ) {
378 0         0 $rulenum = 2.4; $Y = $1; $m = $2; $d = $3;
  0         0  
  0         0  
  0         0  
379             # [whois.relcom.net] changed: support@webnames.ru 20030815
380             } elsif ( $whois =~ m/changed:.+?(\d{4})(\d{2})(\d{2})/is ) {
381 0         0 $rulenum = 2.5; $Y = $1; $m = $2; $d = $3;
  0         0  
  0         0  
  0         0  
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 3         5 $rulenum = 4.1; $b = $1; $d = $2; $Y = $3;
  3         7  
  3         4  
  3         5  
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 1         2 $rulenum = 4.2; $b = $1; $d = $2; $Y = $3;
  1         4  
  1         2  
  1         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 1         2 $rulenum = 4.3; $b = $1; $d = $2; $Y = $3;
  1         4  
  1         3  
  1         4  
391             } elsif ( $whois =~ m&created.+?(\d{2})-(\d{2})-(\d{4})&is ) {
392 0         0 $rulenum = 5.1; $m = $1; $d = $2; $Y = $3;
  0         0  
  0         0  
  0         0  
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 0         0 $rulenum = 5.3; $d = $1; $m = $2; $Y = $3;
  0         0  
  0         0  
  0         0  
396             # [whois.jprs.jp] [登録年月日] 2001/04/23
397             } elsif ( $whois =~ m{ \[登録年月日\] \s+ ( \d{4} ) / ( \d{2} ) / ( \d{2} ) }sx ) {
398 1         3 $rulenum = 7.4; $Y = $1; $m = $2; $d = $3;
  1         4  
  1         2  
  1         4  
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 1         3 $rulenum = 7.5; $Y = $1; $m = $2; $d = $3;
  1         2  
  1         2  
  1         2  
402             } else {
403 0         0 warn "Can't recognise creation date format\n";
404 0         0 return;
405             }
406              
407 16         24 my $fstr = '';
408 16         18 my $dstr = '';
409 16 50       34 $fstr .= $Y ? '%Y ' : '%y ';
410 16 50       36 $dstr .= $Y ? "$Y " : "$y ";
411              
412 16 100 100     109 if ( $b && length $b > 3 ) {
    100 66        
413 1         2 $fstr .= '%B ';
414             }
415             elsif ( $b && length $b == 3 ) {
416 7         9 $fstr .= '%b ';
417             }
418             else {
419 8         13 $fstr .= '%m ';
420             }
421              
422 16 100       42 $dstr .= $b ? "$b " : "$m ";
423              
424 16         22 $fstr .= '%d';
425 16         20 $dstr .= $d;
426              
427 16         31 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
431             sub _dates_int_ru {
432 13     13   39 my ( $whois ) = @_;
433 13 50       25 return unless $whois;
434              
435 13         15 my ( $reg_till, $free_date, $created );
436              
437 13 100       63 $reg_till = $1 if $whois =~ /reg-till:\s*(.+?)\n/s ;
438 13 50       36 $reg_till = $1 if $whois =~ /payed-till:\s*(.+?)\n/s ;
439 13 100       68 $reg_till = $1 if $whois =~ /paid-till:\s*(.+?)\n/s ;
440 13 100       54 $free_date = $1 if $whois =~ /free-date:\s*(.+?)\n/s ;
441 13 100       45 $created = $1 if $whois =~ /created:\s+(.+?)\n/s ;
442 13 100       63 $reg_till = $1 if $whois =~ /Delegated till\s*(.+?)\n/s;
443              
444 13         15 my $format = '%Y-%m-%dT%H:%M:%SZ';
445             # OLD format date
446 13 100 100     172 if (
      100        
      66        
      100        
      66        
447             $created && $created =~ /\./
448             ||
449             $reg_till && $reg_till =~ /\./
450             ||
451             $free_date && $free_date =~ /\./
452             ) {
453              
454 4         5 $format = '%Y-%m-%d';
455              
456 4 100       12 $reg_till =~ tr/./-/ if $reg_till;
457 4 100       8 $free_date =~ tr/./-/ if $free_date;
458 4 100       9 $created =~ tr/./-/ if $created;
459             }
460              
461 13 100       22 if ( $created ) {
462             # Guess reg-till date
463 7         15 $created = decode_date( $created, $format );
464              
465 7         38 my $t = $created;
466              
467 7 50 33     33 if ( $t && !$reg_till && !$free_date ) {
      33        
468 0         0 $t += 0;
469 0         0 while ( $t < localtime() ) {
470 0 0       0 $t += ONE_YEAR + ( $t->is_leap_year() ? 1 : 0 );
471             }
472 0         0 $reg_till = $t->strftime( $format );
473             }
474             }
475              
476 13 50 66     290 unless ( $reg_till || $free_date ) {
477 0         0 warn "Can't obtain expiration date from ($reg_till)\n";
478 0         0 return;
479             }
480              
481 13         43 $reg_till = decode_date( $reg_till, $format );
482 13         23 $free_date = decode_date( $free_date, $format );
483              
484 13 100 66     39 if ( !$reg_till && $free_date ) {
485 3         127 $reg_till = $free_date - 33 * ONE_DAY;
486             }
487              
488 13         463 return $created, $reg_till, $free_date;
489             }
490              
491             sub _isin {
492 83     83   94 my ( $val, $arr ) = @_;
493 83 50       164 return 0 unless $arr;
494              
495 83         144 for ( @$arr ) {
496 438 100       869 return 1 if $_ eq $val;
497             }
498              
499 70         186 return 0;
500             }
501              
502             sub import {
503 1     1   8 my $mypkg = shift;
504 1         2 my $callpkg = caller;
505              
506 1     1   7 no strict 'refs';
  1         2  
  1         87  
507              
508             # export subs
509 1         3 *{ "$callpkg\::$_" } = \&{ "$mypkg\::$_" } for @EXPORT, @_;
  7         27  
  7         16  
510             }
511              
512              
513             1;
514             __END__