http export

diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index d15a879..15b207e 100644 (file)
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -636,6 +636,37 @@ tie my %bind_slave_options, 'Tie::IxHash',
                      default => '/etc/bind/named.conf' },
 ;
 
+tie my %http_options, 'Tie::IxHash',
+  'method' => { label   =>'Method',
+                type    =>'select',
+                #options =>[qw(POST GET)],
+                options =>[qw(POST)],
+                default =>'POST' },
+  'url'    => { label   => 'URL', default => 'http://', },
+  'insert_data' => {
+    label   => 'Insert data',
+    type    => 'textarea',
+    default => join("\n",
+      'DomainName $svc_x->domain',
+      'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]',
+      'test 1',
+      'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i',
+    ),
+  },
+  'delete_data' => {
+    label   => 'Delete data',
+    type    => 'textarea',
+    default => join("\n",
+    ),
+  },
+  'replace_data' => {
+    label   => 'Replace data',
+    type    => 'textarea',
+    default => join("\n",
+    ),
+  },
+;
+
 tie my %sqlmail_options, 'Tie::IxHash',
   'datasrc'  => { label=>'DBI data source' },
   'username' => { label=>'Database username' },
@@ -740,6 +771,12 @@ tie my %sqlmail_options, 'Tie::IxHash',
       'notes' => 'Batch export of BIND configuration file to a secondary nameserver.  Zones are slaved from the listed masters.  <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed.  Run bin/bind.export to export the files.',
     },
 
+    'http' => {
+      'desc' => 'Send an HTTP or HTTPS GET or POST request',
+      'options' => \%http_options,
+      'notes' => 'Send an HTTP or HTTPS GET or POST to the specified URL.  <a href="http://search.cpan.org/search?dist=libwww-perl">libwww-perl</a> must be installed.  For HTTPS support, <a href="http://search.cpan.org/search?dist=Crypt-SSLeay">Crypt::SSLeay</a> or <a href="http://search.cpan.org/search?dist=IO-Socket-SSL">IO::Socket::SSL</a> is required.',
+    },
+
     'sqlmail' => {
       'desc' => 'Real-time export to SQL-backed mail server',
       'options' => \%sqlmail_options,

diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm
new file mode 100644 (file)
index 0000000..0e02f0f
--- /dev/null
+++ b/FS/FS/part_export/http.pm
@@ -0,0 +1,88 @@
+package FS::part_export::http;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+  my $self = shift;
+  $self->_export_command('insert', @_);
+}
+
+sub _export_delete {
+  my $self = shift;
+  $self->_export_command('delete', @_);
+}
+
+sub _export_command {
+  my( $self, $action, $svc_x ) = ( shift, shift, shift );
+
+  return unless $self->option("${action}_data");
+
+  $self->http_queue( $svc_x->svcnum,
+    $self->option('method'),
+    $self->option('url'),
+    map {
+      /^\s*(\S+)\s+(.*)$/ or /()()/;
+      my( $field, $value_expression ) = ( $1, $2 );
+      my $value = eval $value_expression;
+      die $@ if $@;
+      ( $field, $value );
+    } split(/\n/, $self->option("${action}_data") )
+  );
+
+}
+
+sub _export_replace {
+  my( $self, $new, $old ) = ( shift, shift, shift );
+
+  return unless $self->option('replace_data');
+
+  $self->http_queue( $svc_x->svcnum,
+    $self->option('method'),
+    $self->option('url'),
+    map {
+      /^\s*(\S+)\s+(.*)$/ or /()()/;
+      my( $field, $value_expression ) = ( $1, $2 );
+      die $@ if $@;
+      ( $field, $value );
+    } split(/\n/, $self->option('replace_data') )
+  );
+
+}
+
+sub http_queue {
+  my($self, $svcnum) = (shift, shift);
+  my $queue = new FS::queue {
+    'svcnum' => $svcnum,
+    'job'    => "FS::part_export::http::http",
+  };
+  $queue->insert( @_ );
+}
+
+sub http {
+  my($method, $url, @data) = @_;
+
+  $method = lc($method);
+
+  eval "use LWP::UserAgent;";
+  die "using LWP::UserAgent: $@" if $@;
+  eval "use HTTP::Request::Common;";
+  die "using HTTP::Request::Common: $@" if $@;
+
+  my $ua = LWP::UserAgent->new;
+
+  #my $response = $ua->$method(
+  #  $url, \%data,
+  #  'Content-Type'=>'application/x-www-form-urlencoded'
+  #);
+  my $req = HTTP::Request::Common::POST( $url, \@data );
+  my $response = $ua->request($req);
+
+  die $response->error_as_HTML if $response->is_error;
+
+}
+

diff --git a/FS/MANIFEST b/FS/MANIFEST
index da04b1d..a6a8d93 100644 (file)
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -56,6 +56,7 @@ FS/part_export/bind_slave.pm
 FS/part_export/bsdshell.pm
 FS/part_export/cp.pm
 FS/part_export/cyrus.pm
+FS/part_export/http.pm
 FS/part_export/infostreet.pm
 FS/part_export/null.pm
 FS/part_export/shellcommands.pm
@@ -127,6 +128,7 @@ t/part_export-bind_slave.t
 t/part_export-bsdshell.t
 t/part_export-cp.t
 t/part_export-cyrus.t
+t/part_export-http.t
 t/part_export-infostreet.t
 t/part_export-null.t
 t/part_export-shellcommands.t

diff --git a/FS/t/part_export-http.t b/FS/t/part_export-http.t
new file mode 100644 (file)
index 0000000..ba7209d
--- /dev/null
+++ b/FS/t/part_export-http.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::part_export::http_post;
+$loaded=1;
+print "ok 1\n";