From 8bc1ee56aea60731d98efd0e2399b202e9969187 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Jul 2002 14:21:56 +0000 Subject: [PATCH] http export --- FS/FS/part_export.pm | 37 ++++++++++++++++++++ FS/FS/part_export/http.pm | 88 +++++++++++++++++++++++++++++++++++++++++++++++ FS/MANIFEST | 2 ++ FS/t/part_export-http.t | 5 +++ 4 files changed, 132 insertions(+) create mode 100644 FS/FS/part_export/http.pm create mode 100644 FS/t/part_export-http.t diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index d15a87986..15b207e03 100644 --- 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. File::Rsync 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. libwww-perl must be installed. For HTTPS support, Crypt::SSLeay or IO::Socket::SSL 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 index 000000000..0e02f0f8e --- /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 da04b1d5c..a6a8d935e 100644 --- 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 index 000000000..ba7209d10 --- /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"; -- 2.11.0