The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
#
# A Net::DRI example for .COOP : creation of contacts, hosts, domains, and deleting domain

use utf8;
use strict;
use warnings;

use Net::DRI;

## Fill these variables : your registrar id, password, and contact prefix
my $CLID='';
my $PASS='';
my $CID_PREFIX=''; ## The registry mandates all contacts ID to start with a specific prefix, tied to your account


my $dri=Net::DRI->new({cache_ttl=>10,logging=>'files'});

my $ok=eval {
############################################################################################################
$dri->add_registry('COOP',{clid=>$CLID});

## This connects to .COOP server for tests : make sure you have local files key.pem and cert.pem
my $rc=$dri->target('COOP')->add_current_profile('profile1','epp',{ssl_key_file=>'./key.pem',ssl_cert_file=>'./cert.pem',ssl_ca_file=>'./cert.pem',client_login=>$CLID,client_password=>$PASS});

die($rc) unless $rc->is_success(); ## Here we catch all errors during setup of transport, such as authentication errors

my $t1=time()%100;
my $c1=new_contact($dri); ## sponsor 1
$c1->srid($CID_PREFIX.'1s'.$t1);
my $c2=new_contact($dri); ## sponsor 2
$c2->srid($CID_PREFIX.'s'.($t1+1));
my $c3=new_contact($dri);
$c3->srid($CID_PREFIX.'r'.($t1+2));
$c3->sponsors([$c1->srid(),$c2->srid()]); ## $c3 will be used as registrant, hence it needs 2 sponsors !
$c3->mailing_list(1);
my $c4=new_contact($dri);
$c4->srid($CID_PREFIX.'c'.($t1+3)); ## will be  used as billing/technical/admin
$c4->mailing_list(0);

$rc=$dri->contact_create($c1);
die($rc) unless $rc->is_success();
my $id=$dri->get_info('id');
print "Contact1 created, id=$id\n";
$rc=$dri->contact_create($c2);
die($rc) unless $rc->is_success();
$id=$dri->get_info('id');
print "Contact2 created, id=$id\n";
$rc=$dri->contact_create($c3);
die($rc) unless $rc->is_success();
$id=$dri->get_info('id');
print "Contact3 created, id=$id\n";
$rc=$dri->contact_create($c4);
die($rc) unless $rc->is_success();
$id=$dri->get_info('id');
print "Contact3 created, id=$id\n";


my $nso=$dri->local_object('hosts');
foreach my $ns (qw/ns1.example.com ns2.example.com/)
{
 print "Attempting to create host $ns ";
 my $e=$dri->host_exist($ns);
 if ($e==0)
 {
  $rc=$dri->host_create($ns);
  print $rc->is_success()? "OK\n" : "KO\n";
 } else
 {
  print "EXIST already\n";
 }
 $nso->add($ns);
}

my $dom='toto-'.time().'.coop';
$rc=$dri->domain_check($dom);
print "$dom exists: ".($dri->get_info('exist')? 'YES' : 'NO')."\n";
my $cs=$dri->local_object('contactset');
$cs->set($c3,'registrant');
$cs->set($c4,'billing');
$cs->set($c4,'tech');
$cs->set($c4,'admin');
print "Attempting to create domain $dom\n";
$rc=$dri->domain_create($dom,{pure_create=>1,duration=>$dri->local_object('duration',years => 2),ns=>$nso,contact=>$cs,auth=>{pw=>'whatever'}});
print "$dom created successfully:".($rc->is_success()? 'YES' : 'NO')."\n";

$rc=$dri->domain_check($dom);
print "$dom does exists now: ".($dri->get_info('exist')? 'YES' : 'NO')."\n";
$rc=$dri->domain_info($dom);
print "$dom domain_info: ".($rc->is_success()? 'YES' : 'NO')."\n";

$rc=$dri->domain_delete($dom,{pure_delete => 1});
print "$dom domain_delete: ".($rc->is_success()? 'YES' : 'NO')."\n";

$rc=$dri->contact_delete($c3);
print 'Contact3 deleted successfully: '.($rc->is_success()? 'YES' : 'NO')."\n";
$rc=$dri->contact_delete($c1);
print 'Contact1 deleted successfully: '.($rc->is_success()? 'YES' : 'NO')."\n";
$rc=$dri->contact_delete($c2);
print 'Contact2 deleted successfully: '.($rc->is_success()? 'YES' : 'NO')."\n";
$rc=$dri->contact_delete($c4);
print 'Contact4 deleted successfully: '.($rc->is_success()? 'YES' : 'NO')."\n";


$dri->end();
};

if (! $ok)
{ 
 my $err=$@;
 print "\n\nAn EXCEPTION happened !\n";
 if (ref $err)
 {
  $err->print();
 } else
 {
  print $err;
 }
} else
{
 print "\n\nNo exception happened, everything seems OK !";
}

print "\n";
exit 0;

######################################################

sub new_contact
{
 my ($dri)=@_;
 my $c=$dri->local_object('contact');
 $c->name('My Name');
 $c->org('My Organisation àé æ'.time());
 $c->street(['My Address']);
 $c->city('My city');
 $c->pc(11111);
 $c->cc('FR');
 $c->email('test@example.com');
 $c->voice('+33.1111111');
 $c->fax('+33.2222222');
 $c->auth({pw => 'whatever'});
 $c->lang('fr');
 $c->loc2int(); ## registry operator needs internationalized & localized forms (not just internationalized alone)
 return $c;
}