FS/FS/part_export/http.pm

   1 package FS::part_export::http;
   2
   3 use vars qw(@ISA %info);
   4 use Tie::IxHash;
   5 use FS::part_export;
   6
   7 @ISA = qw(FS::part_export);
   8
   9 tie my %options, 'Tie::IxHash',
  10   'method' => { label   =>'Method',
  11                 type    =>'select',
  12                 #options =>[qw(POST GET)],
  13                 options =>[qw(POST)],
  14                 default =>'POST' },
  15   'url'    => { label   => 'URL', default => 'http://', },
  16   'insert_data' => {
  17     label   => 'Insert data',
  18     type    => 'textarea',
  19     default => join("\n",
  20       'DomainName $svc_x->domain',
  21       'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]',
  22       'test 1',
  23       'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i',
  24     ),
  25   },
  26   'delete_data' => {
  27     label   => 'Delete data',
  28     type    => 'textarea',
  29     default => join("\n",
  30     ),
  31   },
  32   'replace_data' => {
  33     label   => 'Replace data',
  34     type    => 'textarea',
  35     default => join("\n",
  36     ),
  37   },
  38 ;
  39
  40 %info = (
  41   'svc'     => 'svc_domain',
  42   'desc'    => 'Send an HTTP or HTTPS GET or POST request',
  43   'options' => \%options,
  44   'notes'   => <<'END'
  45 Send an HTTP or HTTPS GET or POST to the specified URL.  For HTTPS support,
  46 <a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a>
  47 or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a>
  48 is required.
  49 END
  50 );
  51
  52 sub rebless { shift; }
  53
  54 sub _export_insert {
  55   my $self = shift;
  56   $self->_export_command('insert', @_);
  57 }
  58
  59 sub _export_delete {
  60   my $self = shift;
  61   $self->_export_command('delete', @_);
  62 }
  63
  64 sub _export_command {
  65   my( $self, $action, $svc_x ) = ( shift, shift, shift );
  66
  67   return unless $self->option("${action}_data");
  68
  69   $self->http_queue( $svc_x->svcnum,
  70     $self->option('method'),
  71     $self->option('url'),
  72     map {
  73       /^\s*(\S+)\s+(.*)$/ or /()()/;
  74       my( $field, $value_expression ) = ( $1, $2 );
  75       my $value = eval $value_expression;
  76       die $@ if $@;
  77       ( $field, $value );
  78     } split(/\n/, $self->option("${action}_data") )
  79   );
  80
  81 }
  82
  83 sub _export_replace {
  84   my( $self, $new, $old ) = ( shift, shift, shift );
  85
  86   return unless $self->option('replace_data');
  87
  88   $self->http_queue( $svc_x->svcnum,
  89     $self->option('method'),
  90     $self->option('url'),
  91     map {
  92       /^\s*(\S+)\s+(.*)$/ or /()()/;
  93       my( $field, $value_expression ) = ( $1, $2 );
  94       die $@ if $@;
  95       ( $field, $value );
  96     } split(/\n/, $self->option('replace_data') )
  97   );
  98
  99 }
 100
 101 sub http_queue {
 102   my($self, $svcnum) = (shift, shift);
 103   my $queue = new FS::queue {
 104     'svcnum' => $svcnum,
 105     'job'    => "FS::part_export::http::http",
 106   };
 107   $queue->insert( @_ );
 108 }
 109
 110 sub http {
 111   my($method, $url, @data) = @_;
 112
 113   $method = lc($method);
 114
 115   eval "use LWP::UserAgent;";
 116   die "using LWP::UserAgent: $@" if $@;
 117   eval "use HTTP::Request::Common;";
 118   die "using HTTP::Request::Common: $@" if $@;
 119
 120   my $ua = LWP::UserAgent->new;
 121
 122   #my $response = $ua->$method(
 123   #  $url, \%data,
 124   #  'Content-Type'=>'application/x-www-form-urlencoded'
 125   #);
 126   my $req = HTTP::Request::Common::POST( $url, \@data );
 127   my $response = $ua->request($req);
 128
 129   die $response->error_as_HTML if $response->is_error;
 130
 131 }
 132
 133 1;
 134