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