1 package FS::part_export::http;
3 use base qw( FS::part_export );
4 use vars qw( %options %info );
7 use HTTP::Request::Common qw( POST );
10 tie %options, 'Tie::IxHash',
11 'method' => { label =>'Method',
13 #options =>[qw(POST GET)],
16 'url' => { label => 'URL', default => 'http://', },
17 'ssl_no_verify' => { label => 'Skip SSL certificate validation',
21 label => 'Insert data',
24 'DomainName $svc_x->domain',
25 'Email ( grep { $_ !~ /^(POST|FAX)$/ } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]',
27 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i',
31 label => 'Delete data',
37 label => 'Replace data',
43 label => 'Suspend data',
49 label => 'Unsuspend data',
55 label => 'Success Regexp',
61 'svc' => 'svc_domain',
62 'desc' => 'Send an HTTP or HTTPS GET or POST request, for domains1',
63 'options' => \%options,
66 Send an HTTP or HTTPS GET or POST to the specified URL on domain addition,
67 modification and deletion.
68 <p>Each "Data" option takes a list of <i>name value</i> pairs on successive
70 <ul><li><i>name</i> is an unquoted, literal string without whitespace.</li>
71 <li><i>value</i> is a Perl expression that will be evaluated. If it's a
72 literal string, it must be quoted. This expression has access to the
73 svc_domain object as '$svc_x' (or '$new' and '$old' in "Replace Data")
74 and the customer record as '$cust_main'.</li></ul>
75 If "Success Regexp" is specified, the response from the server will be
76 tested against it to determine if the export succeeded.</p>
80 sub rebless { shift; }
84 $self->_export_command('insert', @_);
89 $self->_export_command('delete', @_);
94 $self->_export_command('suspend', @_);
97 sub _export_unsuspend {
99 $self->_export_command('unsuspend', @_);
102 sub _export_command {
103 my( $self, $action, $svc_x ) = ( shift, shift, shift );
105 return unless $self->option("${action}_data");
107 my $cust_main = $svc_x->cust_main or return;
109 $self->http_queue( $svc_x->svcnum,
110 ( $self->option('ssl_no_verify') ? 'ssl_no_verify' : '' ),
111 $self->option('method'),
112 $self->option('url'),
113 $self->option('success_regexp'),
115 /^\s*(\S+)\s+(.*)$/ or /()()/;
116 my( $field, $value_expression ) = ( $1, $2 );
117 my $value = eval $value_expression;
120 } split(/\n/, $self->option("${action}_data") )
125 sub _export_replace {
126 my( $self, $new, $old ) = ( shift, shift, shift );
128 return unless $self->option('replace_data');
130 my $new_cust_main = $new->cust_main or return;
131 my $cust_main = $new_cust_main; #so folks can use $new_cust_main or $cust_main
133 $self->http_queue( $new->svcnum,
134 ( $self->option('ssl_no_verify') ? 'ssl_no_verify' : '' ),
135 $self->option('method'),
136 $self->option('url'),
137 $self->option('success_regexp'),
139 /^\s*(\S+)\s+(.*)$/ or /()()/;
140 my( $field, $value_expression ) = ( $1, $2 );
141 my $value = eval $value_expression;
144 } split(/\n/, $self->option('replace_data') )
150 my($self, $svcnum) = (shift, shift);
151 my $queue = new FS::queue { 'job' => "FS::part_export::http::http" };
152 $queue->svcnum($svcnum) if $svcnum;
153 $queue->insert( @_ );
157 my $ssl_no_verify = ( $_[0] eq 'ssl_no_verify' || $_[0] eq '' ) ? shift : '';
158 my($method, $url, $success_regexp, @data) = @_;
160 $method = lc($method);
163 push @lwp_opts, 'ssl_opts' => {
164 verify_hostname => 0,
165 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
168 my $ua = LWP::UserAgent->new(@lwp_opts);
170 #my $response = $ua->$method(
172 # 'Content-Type'=>'application/x-www-form-urlencoded'
174 my $req = HTTP::Request::Common::POST( $url, \@data );
175 my $response = $ua->request($req);
177 die $response->error_as_HTML if $response->is_error;
179 if(length($success_regexp) > 1) {
180 my $response_content = $response->content;
181 die $response_content unless $response_content =~ /$success_regexp/;