diff options
author | jeff <jeff> | 2010-01-04 04:13:11 +0000 |
---|---|---|
committer | jeff <jeff> | 2010-01-04 04:13:11 +0000 |
commit | a5cda9b76146da5c3a2c4f5c706c0b7a093a17ca (patch) | |
tree | 1b719767ab887c71f0990c9b6dcb0e49adb7a7d5 /FS | |
parent | 551eccdc359883b2a78edf8672b4766000876650 (diff) |
untested triggering of export on payments, requires config enable (RT5825)
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 | 95 |
3 files changed, 131 insertions, 0 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 503aebd22..46d4a8a58 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1104,6 +1104,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 6a75fe6aa..6004b6cf7 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 ); @@ -402,6 +407,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..dc9f92389 100644 --- a/FS/FS/part_export/domreg_opensrs.pm +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -2,6 +2,7 @@ package FS::part_export::domreg_opensrs; use vars qw(@ISA %info %options $conf); use Tie::IxHash; +use DateTime; use FS::Record qw(qsearchs qsearch); use FS::Conf; use FS::part_export::null; @@ -50,6 +51,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 +218,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 +247,19 @@ sub _export_insert { return "Unknown domain action " . $svc_domain->action; } +sub _export_insert_on_payment { + my( $self, $svc_domain ) = ( shift, shift ); + 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->svcnum ); #_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); @@ -454,6 +473,82 @@ 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 ) = @_; + + 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; + + my $srs = $self->get_srs; + + $rv = $srs->check_transfer($svc_domain->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 + } + + $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 |