add conditions for customer cancelled packages, RT#42043
[freeside.git] / FS / FS / part_export / http.pm
1 package FS::part_export::http;
2
3 use base qw( FS::part_export );
4 use vars qw( %options %info );
5 use Tie::IxHash;
6 use LWP::UserAgent;
7 use HTTP::Request::Common qw( POST );
8 use IO::Socket::SSL;
9
10 tie %options, 'Tie::IxHash',
11   'method' => { label   =>'Method',
12                 type    =>'select',
13                 #options =>[qw(POST GET)],
14                 options =>[qw(POST)],
15                 default =>'POST' },
16   'url'    => { label   => 'URL', default => 'http://', },
17   'ssl_no_verify' => { label => 'Skip SSL certificate validation',
18                        type  => 'checkbox',
19                      },
20   'insert_data' => {
21     label   => 'Insert data',
22     type    => 'textarea',
23     default => join("\n",
24       'DomainName $svc_x->domain',
25       'Email ( grep { $_ !~ /^(POST|FAX)$/ } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]',
26       'test 1',
27       'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i',
28     ),
29   },
30   'delete_data' => {
31     label   => 'Delete data',
32     type    => 'textarea',
33     default => join("\n",
34     ),
35   },
36   'replace_data' => {
37     label   => 'Replace data',
38     type    => 'textarea',
39     default => join("\n",
40     ),
41   },
42   'suspend_data' => {
43     label   => 'Suspend data',
44     type    => 'textarea',
45     default => join("\n",
46     ),
47   },
48   'unsuspend_data' => {
49     label   => 'Unsuspend data',
50     type    => 'textarea',
51     default => join("\n",
52     ),
53   },
54   'success_regexp' => {
55     label  => 'Success Regexp',
56     default => '',
57   },
58 ;
59
60 %info = (
61   'svc'     => 'svc_domain',
62   'desc'    => 'Send an HTTP or HTTPS GET or POST request',
63   'options' => \%options,
64   'no_machine' => 1,
65   'notes'   => <<'END'
66 Send an HTTP or HTTPS GET or POST to the specified URL.  For HTTPS support,
67 <a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a>
68 or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a>
69 is required.
70 END
71 );
72
73 sub rebless { shift; }
74
75 sub _export_insert {
76   my $self = shift;
77   $self->_export_command('insert', @_);
78 }
79
80 sub _export_delete {
81   my $self = shift;
82   $self->_export_command('delete', @_);
83 }
84
85 sub _export_suspend {
86   my $self = shift;
87   $self->_export_command('suspend', @_);
88 }
89
90 sub _export_unsuspend {
91   my $self = shift;
92   $self->_export_command('unsuspend', @_);
93 }
94
95 sub _export_command {
96   my( $self, $action, $svc_x ) = ( shift, shift, shift );
97
98   return unless $self->option("${action}_data");
99
100   my $cust_main = $svc_x->cust_main or return;
101
102   $self->http_queue( $svc_x->svcnum,
103     ( $self->option('ssl_no_verify') ? 'ssl_no_verify' : '' ),
104     $self->option('method'),
105     $self->option('url'),
106     $self->option('success_regexp'),
107     map {
108       /^\s*(\S+)\s+(.*)$/ or /()()/;
109       my( $field, $value_expression ) = ( $1, $2 );
110       my $value = eval $value_expression;
111       die $@ if $@;
112       ( $field, $value );
113     } split(/\n/, $self->option("${action}_data") )
114   );
115
116 }
117
118 sub _export_replace {
119   my( $self, $new, $old ) = ( shift, shift, shift );
120
121   return unless $self->option('replace_data');
122
123   my $new_cust_main = $new->cust_main or return;
124   my $cust_main = $new_cust_main; #so folks can use $new_cust_main or $cust_main
125
126   $self->http_queue( $new->svcnum,
127     ( $self->option('ssl_no_verify') ? 'ssl_no_verify' : '' ),
128     $self->option('method'),
129     $self->option('url'),
130     $self->option('success_regexp'),
131     map {
132       /^\s*(\S+)\s+(.*)$/ or /()()/;
133       my( $field, $value_expression ) = ( $1, $2 );
134       my $value = eval $value_expression;
135       die $@ if $@;
136       ( $field, $value );
137     } split(/\n/, $self->option('replace_data') )
138   );
139
140 }
141
142 sub http_queue {
143   my($self, $svcnum) = (shift, shift);
144   my $queue = new FS::queue { 'job' => "FS::part_export::http::http" };
145   $queue->svcnum($svcnum) if $svcnum;
146   $queue->insert( @_ );
147 }
148
149 sub http {
150   my $ssl_no_verify = ( $_[0] eq 'ssl_no_verify' || $_[0] eq '' ) ? shift : '';
151   my($method, $url, $success_regexp, @data) = @_;
152
153   $method = lc($method);
154
155   my @lwp_opts = ();
156   push @lwp_opts, 'ssl_opts' => {
157                     verify_hostname => 0,
158                     SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
159                   }
160     if $ssl_no_verify;
161   my $ua = LWP::UserAgent->new(@lwp_opts);
162
163   #my $response = $ua->$method(
164   #  $url, \%data,
165   #  'Content-Type'=>'application/x-www-form-urlencoded'
166   #);
167   my $req = HTTP::Request::Common::POST( $url, \@data );
168   my $response = $ua->request($req);
169
170   die $response->error_as_HTML if $response->is_error;
171
172   if(length($success_regexp) > 1) {
173     my $response_content = $response->content;
174     die $response_content unless $response_content =~ /$success_regexp/;
175   }
176
177 }
178
179 1;
180