From a5cda9b76146da5c3a2c4f5c706c0b7a093a17ca Mon Sep 17 00:00:00 2001 From: jeff Date: Mon, 4 Jan 2010 04:13:11 +0000 Subject: [PATCH] untested triggering of export on payments, requires config enable (RT5825) --- FS/FS/Conf.pm | 7 ++ FS/FS/cust_bill_ApplicationCommon.pm | 29 ++++++++ FS/FS/part_export/domreg_opensrs.pm | 95 ++++++++++++++++++++++++++ bin/opensrs_domain_pkgs | 126 +++++++++++++++++++++++++++++++++++ 4 files changed, 257 insertions(+) create mode 100755 bin/opensrs_domain_pkgs 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 diff --git a/bin/opensrs_domain_pkgs b/bin/opensrs_domain_pkgs new file mode 100755 index 000000000..ae1476104 --- /dev/null +++ b/bin/opensrs_domain_pkgs @@ -0,0 +1,126 @@ +#!/usr/bin/perl -w + +use strict; +use DateTime; +use Date::Format; +use Date::Parse; +use Net::OpenSRS; +use Net::Whois::Raw; +use Data::Dumper; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs qsearch); +use FS::Conf; +use FS::svc_domain; +use FS::part_pkg; +use FS::part_export; + +my $exportnum = 1; +my $pkgpart = 631; +my $user = 'qis'; + +adminsuidsetup $user; + +my $part_export = qsearchs('part_export' => { exportnum => $exportnum }) + or die "can't find export $exportnum\n"; + +my $srs = $part_export->get_srs; + +my $rv = $srs->make_request( + { + action => 'get_domains_by_expiredate', + object => 'domain', + attributes => { + exp_from => time2str('%Y-%m-%d', time() - 4*24*60*60), + exp_to => time2str('%Y-%m-%d', time() + 10*366*24*60*60), + limit => 10000, + } + } +); + +die $rv->{response_text} unless $rv->{is_success}; + +my %domains = map { $_->{name}, $_ } @{ $rv->{attributes}->{exp_domains} }; + +# each is of form +# { +# 'f_let_expire' => 'N', +# 'name' => 'wolfecpa.com', +# 'f_auto_renew' => 'N', +# 'expiredate' => '2017-09-16 04:00:00' +# }, + +foreach my $svc_domain ( $part_export->svc_x ) { + unless ( exists($domains{$svc_domain->domain}) ) { + warn $svc_domain->domain. " not at registrar. No action taken.\n"; + next; + } + + $domains{$svc_domain->domain}{seen} = 1; + + unless ( $domains{$svc_domain->domain}{expiredate} =~ + /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/ ) + { + warn "Can't parse expiration date for ". $svc_domain->domain. " skipping\n"; + next; + } + + 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 $expiretime = $exp->epoch; + + my $error = $part_export->is_supported_domain($svc_domain); + warn $error if $error; + $error = undef; + + my $create = ''; + my $whois = whois($svc_domain->domain); + $whois =~ /Record created on (\d{1,2}-\w{3}-\d{4})\./ && ($create = $1); + my $createtime = str2time($create); + + unless ($createtime) { + $exp->subtract( 'years' => 1 ); + $createtime = $exp->epoch; + } + + my $new; + my $cust_svc = $svc_domain->cust_svc; + my $cust_pkg = $cust_svc->cust_pkg; + unless ($cust_pkg) { + warn $svc_domain->domain. " not linked to package. No action taken.\n"; + next; + } + + foreach my $pkg ( grep { $_->pkgpart == $pkgpart } $cust_pkg->cust_main->ncancelled_pkgs ) { + next if $pkg->cust_svc; # only handles simple 1 domain/package case + $cust_svc->pkgnum($pkg->pkgnum); + $error = $cust_svc->replace; + die "error linking to empty package: $error\n" if $error; + $cust_pkg = $pkg; + last; + } + + unless ($cust_pkg->pkgpart == $pkgpart) { + $new = new FS::cust_pkg + { custnum => $cust_pkg->custnum, pkgpart => $pkgpart }; + my $error = $new->insert; + die "error inserting package: $error\n" if $error; + $cust_svc->pkgnum($new->pkgnum); + $error = $cust_svc->replace; + die "error linking to new package: $error\n" if $error; + $cust_pkg = $new; + } + + # set dates on package if it was empty? + $cust_pkg->bill($expiretime); + $cust_pkg->setup($createtime); + $error = $cust_pkg->replace; + die $error if $error; +} + -- 2.11.0