1## Domain Registry Interface, Registry Driver for .PT 2## 3## Copyright (c) 2008,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved. 4## 5## This file is part of Net::DRI 6## 7## Net::DRI is free software; you can redistribute it and/or modify 8## it under the terms of the GNU General Public License as published by 9## the Free Software Foundation; either version 2 of the License, or 10## (at your option) any later version. 11## 12## See the LICENSE file that comes with this distribution for more details. 13# 14# 15# 16######################################################################################### 17 18package Net::DRI::DRD::PT; 19 20use strict; 21use warnings; 22 23use base qw/Net::DRI::DRD/; 24 25use DateTime::Duration; 26use DateTime; 27use Net::DRI::Util; 28use Net::DRI::Data::Contact::FCCN; 29 30our $VERSION=do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); }; 31 32__PACKAGE__->make_exception_for_unavailable_operations(qw/contact_check contact_delete contact_transfer contact_transfer_start contact_transfer_stop contact_transfer_query contact_transfer_accept contact_transfer_refuse message_retrieve message_delete message_waiting message_count/); 33 34=pod 35 36=head1 NAME 37 38Net::DRI::DRD::PT - FCCN .PT Registry driver for Net::DRI 39 40=head1 DESCRIPTION 41 42Please see the README file for details. 43 44=head1 SUPPORT 45 46For now, support questions should be sent to: 47 48E<lt>netdri@dotandco.comE<gt> 49 50Please also see the SUPPORT file in the distribution. 51 52=head1 SEE ALSO 53 54E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt> 55 56=head1 AUTHOR 57 58Patrick Mevzek, E<lt>netdri@dotandco.comE<gt> 59 60=head1 COPYRIGHT 61 62Copyright (c) 2008,2009 Patrick Mevzek <netdri@dotandco.com>. 63All rights reserved. 64 65This program is free software; you can redistribute it and/or modify 66it under the terms of the GNU General Public License as published by 67the Free Software Foundation; either version 2 of the License, or 68(at your option) any later version. 69 70See the LICENSE file that comes with this distribution for more details. 71 72=cut 73 74#################################################################################################### 75 76sub new 77{ 78 my $class=shift; 79 my $self=$class->SUPER::new(@_); 80 $self->{info}->{host_as_attr}=1; 81 $self->{info}->{contact_i18n}=1; ## LOC only 82 bless($self,$class); 83 return $self; 84} 85 86sub periods { return map { DateTime::Duration->new(years => $_) } (1,3,5); } 87sub name { return 'FCCN'; } 88sub tlds { return qw/pt net.pt org.pt edu.pt int.pt publ.pt com.pt nome.pt/; } 89sub object_types { return ('domain','contact'); } 90sub profile_types { return qw/epp whois/; } 91 92sub transport_protocol_default 93{ 94 my ($self,$type)=@_; 95 96 return ('Net::DRI::Transport::Socket',{},'Net::DRI::Protocol::EPP::Extensions::FCCN',{}) if $type eq 'epp'; 97 return ('Net::DRI::Transport::Socket',{remote_host=>'whois.nic.pt'},'Net::DRI::Protocol::Whois',{}) if $type eq 'whois'; 98 return; 99} 100 101sub set_factories 102{ 103 my ($self,$po)=@_; 104 $po->factories('contact',sub { return Net::DRI::Data::Contact::FCCN->new(@_); }); 105} 106 107#################################################################################################### 108 109## We can not start a transfer, if domain name has already been transfered less than 15 days ago. 110sub verify_duration_transfer 111{ 112 my ($self,$ndr,$duration,$domain,$op)=@_; 113 ($duration,$domain,$op)=($ndr,$duration,$domain) unless (defined($ndr) && $ndr && (ref($ndr) eq 'Net::DRI::Registry')); 114 115 return 0 unless ($op eq 'start'); ## we are not interested by other cases, they are always OK 116 my $rc=$self->domain_info($ndr,$domain,{hosts=>'none'}); 117 return 1 unless ($rc->is_success()); 118 my $trdate=$ndr->get_info('trDate'); 119 return 0 unless ($trdate && $trdate->isa('DateTime')); 120 121 my $now=DateTime->now(time_zone => $trdate->time_zone()->name()); 122 my $cmp=DateTime->compare($now,$trdate+DateTime::Duration->new(days => 15)); 123 return ($cmp == 1)? 0 : 1; ## we must have : now > transferdate + 15days 124 ## we return 0 if OK, anything else if not 125} 126 127#################################################################################################### 128 129sub domain_renounce 130{ 131 my ($self,$ndr,$domain,$rd)=@_; 132 $self->enforce_domain_name_constraints($ndr,$domain,'renounce'); 133 return $ndr->process('domain','renounce',[$domain,$rd]); 134} 135 136#################################################################################################### 1371; 138