X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fdomreg_opensrs.pm;h=0c7a95dccc0ca9e0308bd594528e151d773021c2;hb=ffa18709ee8a4d05e18d2d406cf73afe79e52524;hp=1799ed09e8180d27774e3cfb417362d54227a3e0;hpb=0cbb171da2cf3c7059612c0f2fbcf4a8bb80ab58;p=freeside.git

diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm
index 1799ed09e..0c7a95dcc 100644
--- a/FS/FS/part_export/domreg_opensrs.pm
+++ b/FS/FS/part_export/domreg_opensrs.pm
@@ -1,7 +1,8 @@
 package FS::part_export::domreg_opensrs;
 
-use vars qw(@ISA %info %options $conf);
+use vars qw(@ISA %info %options $conf $me $DEBUG);
 use Tie::IxHash;
+use DateTime;
 use FS::Record qw(qsearchs qsearch);
 use FS::Conf;
 use FS::part_export::null;
@@ -38,8 +39,10 @@ gateway when setting up this export.
 =cut
 
 @ISA = qw(FS::part_export::null);
+$me = '[' .  __PACKAGE__ . ']';
+$DEBUG = 0;
 
-my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us/;
+my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us asn.au com.au id.au net.au org.au/;
 
 tie %options, 'Tie::IxHash',
   'username'     => { label => 'Reseller user name at OpenSRS',
@@ -50,6 +53,10 @@ tie %options, 'Tie::IxHash',
                       },
   'masterdomain' => { label => 'Master domain at OpenSRS',
                       },
+  'wait_for_pay' => { label => 'Do not provision until payment is received',
+                      type => 'checkbox',
+                      default => '0',
+                    },
   'debug_level'  => { label => 'Net::OpenSRS debug level',
                       type => 'select',
                       options => [ 0, 1, 2, 3 ],
@@ -66,6 +73,9 @@ tie %options, 'Tie::IxHash',
                       size => scalar(@tldlist),
                       options => [ @tldlist ],
 		      default => 'com net org' },
+  'auoptions'    => { label => 'Enable AU-specific registration fields', 
+		      type => 'checkbox'
+		    },
 ;
 
 %info = (
@@ -213,6 +223,7 @@ sub testmode {
   return 'live' if $self->machine eq "rr-n1-tor.opensrs.net";
   return 'test' if $self->machine eq "horizon.opensrs.net";
   undef;
+
 }
 
 =item _export_insert
@@ -241,6 +252,18 @@ sub _export_insert {
   return "Unknown domain action " . $svc_domain->action;
 }
 
+sub _export_insert_on_payment {
+  my( $self, $svc_domain ) = ( shift, shift );
+  warn "$me:_export_insert_on_payment called\n" if $DEBUG;
+  return '' unless $self->option('wait_for_pay');
+
+  my $queue = new FS::queue {
+    'svcnum' => $svc_domain->svcnum,
+    'job'    => 'FS::part_export::domreg_opensrs::renew_through',
+  };
+  $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action?
+}
+
 ## Domain registration exports do nothing on replace.  Mainly because we haven't decided what they should do.
 #sub _export_replace {
 #  my( $self, $new, $old ) = (shift, shift, shift);
@@ -270,14 +293,17 @@ sub is_supported_domain {
   # Get the TLD of the new domain
   my @bits = split /\./, $svc_domain->domain;
 
-  return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2;
+  return "Can't register subdomains: " . $svc_domain->domain 
+    if (scalar(@bits) != 2 && scalar(@bits) != 3);
 
   my $tld = pop @bits;
+  my $sld = pop @bits;
 
   # See if it's one this export supports
   my @tlds = split /\s+/, $self->option('tlds');
   @tlds =  map { s/\.//; $_ } @tlds;
-  return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds;
+  return "Can't register top-level domain $tld, restricted to: " 
+	    . $self->option('tlds') if ! grep { $_ eq $tld || $_ eq "$sld$tld" } @tlds;
   return undef;
 }
 
@@ -359,6 +385,8 @@ Like most export functions, returns an error message on failure or undef on succ
 sub register {
   my ( $self, $svc_domain, $years ) = @_;
 
+  $years = 1 unless $years; #default to 1 year since we don't seem to pass it
+
   return "Net::OpenSRS does not support period other than 1 year" if $years != 1;
 
   eval "use Net::OpenSRS;";
@@ -371,15 +399,21 @@ sub register {
 
   my $c = gen_contact_info($cust_main);
 
+  if ( $svc_domain->domain =~ /\.au$/ ) {
+	$c->{'registrant_name'} = $svc_domain->au_registrant_name;
+	$c->{'eligibility_type'} = $svc_domain->au_eligibility_type;
+  }
+
   $err = validate_contact_info($c);
   return $err if $err;
 
   my $srs = $self->get_srs;
 
-  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
-  if (!$cookie) {
-     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
-  }
+#  cookie not required for registration
+#  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
+#  if (!$cookie) {
+#     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
+#  }
 
 #  return "Domain registration not enabled" if !$self->option('register');
   return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
@@ -454,6 +488,87 @@ sub renew {
   return ''; # Should only get here if renewal succeeded
 }
 
+=item renew_through [ EPOCH_DATE ]
+
+Attempts to renew the domain through the specified date.  If no date is
+provided it is gleaned from the associated cust_pkg bill date
+
+Like some export functions, dies on failure or returns undef on success.
+It is always called from the queue.
+
+=cut
+
+sub renew_through {
+  my ( $self, $svc_domain, $date ) = @_;
+
+  warn "$me: renew_through called\n" if $DEBUG;
+  eval "use Net::OpenSRS;";
+  die $@ if $@;
+
+  unless ( $date ) {
+    my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
+    die "Can't renew: no date specified and domain is not in a package."
+      unless $cust_pkg;
+    $date = $cust_pkg->bill;
+  }
+
+  my $err = $self->is_supported_domain( $svc_domain );
+  die $err if $err;
+
+  warn "$me: checking status\n" if $DEBUG;
+  my $rv = $self->get_status($svc_domain);
+  die "Domain ". $svc_domain->domain. " is not renewable"
+    unless $rv->{expdate};
+
+  die "Can't parse expiration date for ". $svc_domain->domain
+    unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
+
+  my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
+  my $exp = DateTime->new( year   => $year,
+                           month  => $month,
+                           day    => $day,
+                           hour   => $hour,
+                           minute => $minute,
+                           second => $second,
+                           time_zone => 'America/New_York',#timezone of opensrs
+                         );
+
+  my $bill = DateTime->
+   from_epoch( 'epoch'     => $date,
+               'time_zone' => DateTime::TimeZone->new( name => 'local' ),
+  );
+
+  my $years = 0;
+  while ( DateTime->compare( $bill, $exp ) > 0 ) {
+    $years++;
+    $exp->add( 'years' => 1 );
+
+    die "Can't renew ". $svc_domain->domain. " for more than 10 years."
+      if $years > 10; #no infinite loop
+  }
+
+  return '' unless $years;
+
+  warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG;
+  my $srs = $self->get_srs;
+  $rv = $srs->make_request(
+    {
+      action     => 'renew',
+      object     => 'domain',
+      attributes => {
+        domain                => $svc_domain->domain,
+        auto_renew            => 0,
+        handle                => 'process',
+        period                => $years,
+        currentexpirationyear => $year,
+      }
+    }
+  );
+  die $rv->{response_text} unless $rv->{is_success};
+
+  return ''; # Should only get here if renewal succeeded
+}
+
 =item revoke
 
 Attempts to revoke the domain registration.  Only succeeds if invoked during the OpenSRS