diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/Conf.pm | 7 | ||||
| -rw-r--r-- | FS/FS/cust_bill_ApplicationCommon.pm | 29 | ||||
| -rw-r--r-- | FS/FS/part_export/domreg_opensrs.pm | 111 |
3 files changed, 142 insertions, 5 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index da5d98399..6248e7e8b 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1112,6 +1112,13 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'trigger_export_insert_on_payment', + 'section' => 'billing', + 'description' => 'Enable exports on payment application.', + 'type' => 'checkbox', + }, + + { 'key' => 'lpr', 'section' => 'required', 'description' => 'Print command for paper invoices, for example `lpr -h\'', diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index 8ba57f36f..fd6fb9e73 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -5,6 +5,11 @@ use vars qw( @ISA $DEBUG $me $skip_apply_to_lineitems_hack ); use List::Util qw(min); use FS::Schema qw( dbdef ); use FS::Record qw( qsearch qsearchs dbh ); +use FS::cust_pkg; +use FS::cust_svc; +use FS::cust_bill_pkg; +use FS::part_svc; +use FS::part_export; @ISA = qw( FS::Record ); @@ -330,6 +335,30 @@ sub apply_to_lineitems { $dbh->rollback if $oldAutoCommit; return $error; } + + # trigger export_insert_on_payment + if ( $conf->exists('trigger_export_insert_on_payment') + && $cust_bill_pkg->pkgnum > 0 ) + { + if ( my $cust_pkg = $cust_bill_pkg->cust_pkg ) { + + foreach my $cust_svc ( $cust_pkg->cust_svc ) { + my $svc_x = $cust_svc->svc_x; + my @part_export = grep { $_->can('export_insert_on_payment') } + $cust_svc->part_svc->part_export; + + foreach my $part_export ( $cust_svc->part_svc->part_export ) { + $error = $part_export->_export_insert_on_payment($svc_x); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + } + } + # done trigger export_insert_on_payment + } #everything should always be applied to line items in full now... sanity check diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm index 1799ed09e..a9afc91cc 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,6 +39,8 @@ gateway when setting up this export. =cut @ISA = qw(FS::part_export::null); +$me = '[' . __PACKAGE__ . ']'; +$DEBUG = 1; 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/; @@ -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 ], @@ -213,6 +220,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 +249,20 @@ 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? + + return ''; +} + ## 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); @@ -376,10 +398,11 @@ sub register { 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 +477,84 @@ 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 most export functions, returns an error message on failure or undef on success. + +=cut + +sub renew_through { + my ( $self, $svc_domain, $date ) = @_; + + warn "$me: renew_through called\n" if $DEBUG; + eval "use Net::OpenSRS;"; + return $@ 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." + unless $cust_pkg; + $date = $cust_pkg->bill; + } + + my $err = $self->is_supported_domain( $svc_domain ); + return $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" + unless $rv->{expdate}; + + return "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 ); + + return "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; + 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, + } + } + ); + return $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 |