untested triggering of export on payments, requires config enable (RT5825)

4 files changed, 257 insertions, 0 deletions

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 503aebd..46d4a8a 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 6a75fe6..6004b6c 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 1799ed0..dc9f923 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 0000000..ae14761
--- /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;
+}
+