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