adding export to read mailbox status information, RT#15987

[freeside.git] / FS / FS / part_export / domreg_opensrs.pm

diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm
index 4d6ea8f..0c7a95d 100644 (file)
--- a/FS/FS/part_export/domreg_opensrs.pm
+++ b/FS/FS/part_export/domreg_opensrs.pm
@@ -42,7 +42,7 @@ gateway when setting up this export.
 $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',
@@ -73,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 = (
@@ -259,8 +262,6 @@ sub _export_insert_on_payment {
     'job'    => 'FS::part_export::domreg_opensrs::renew_through',
   };
   $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action?
-
-  return '';
 }
 
 ## Domain registration exports do nothing on replace.  Mainly because we haven't decided what they should do.
@@ -292,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;
 }
 
@@ -381,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;";
@@ -393,6 +399,11 @@ 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;
 
@@ -482,7 +493,8 @@ sub renew {
 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 most export functions, returns an error message on failure or undef on success.
+Like some export functions, dies on failure or returns undef on success.
+It is always called from the queue.
 
 =cut
 
@@ -491,24 +503,24 @@ sub renew_through {
 
   warn "$me: renew_through called\n" if $DEBUG;
   eval "use Net::OpenSRS;";
-  return $@ if $@;
+  die $@ if $@;
 
   unless ( $date ) {
     my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
-    return "Can't renew: no date specified and domain is not in a package."
+    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 );
-  return $err if $err;
+  die $err if $err;
 
   warn "$me: checking status\n" if $DEBUG;
   my $rv = $self->get_status($svc_domain);
-  return "Domain ". $svc_domain->domain. " is not renewable"
+  die "Domain ". $svc_domain->domain. " is not renewable"
     unless $rv->{expdate};
 
-  return "Can't parse expiration date for ". $svc_domain->domain
+  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);
@@ -531,11 +543,13 @@ sub renew_through {
     $years++;
     $exp->add( 'years' => 1 );
 
-    return "Can't renew ". $svc_domain->domain. " for more than 10 years."
+    die "Can't renew ". $svc_domain->domain. " for more than 10 years."
       if $years > 10; #no infinite loop
   }
 
-  warn "$me: renewing ". $svc_domain->domain. "for $years years\n" if $DEBUG;
+  return '' unless $years;
+
+  warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG;
   my $srs = $self->get_srs;
   $rv = $srs->make_request(
     {
@@ -550,7 +564,7 @@ sub renew_through {
       }
     }
   );
-  return $rv->{response_text} unless $rv->{is_success};
+  die $rv->{response_text} unless $rv->{is_success};
 
   return ''; # Should only get here if renewal succeeded
 }