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