X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fdomreg_opensrs.pm;h=0c7a95dccc0ca9e0308bd594528e151d773021c2;hb=ffa18709ee8a4d05e18d2d406cf73afe79e52524;hp=3bfdf4d58c421b9c174434fe269dd6295a83862e;hpb=96628e880ae1b1b2e291f27ea1b1ef500404bdfd;p=freeside.git diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm index 3bfdf4d58..0c7a95dcc 100644 --- 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,7 +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? - } ## Domain registration exports do nothing on replace. Mainly because we haven't decided what they should do. @@ -291,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; } @@ -380,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;"; @@ -392,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; @@ -481,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 @@ -490,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); @@ -530,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( { @@ -549,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 }