X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fhttp_status.pm;h=3e182d3478846ae2b7a484ebab67638b0f42f8d7;hb=bb7e827141c9ed68f30765c9ca2ddcd1d760ad2d;hp=da32ec47edbd7d811b417c212ca42d749d5c8f2f;hpb=dd825e780ad1e7d520f5c2d7f99c0f67fe892781;p=freeside.git diff --git a/FS/FS/part_export/http_status.pm b/FS/FS/part_export/http_status.pm index da32ec47e..3e182d347 100644 --- a/FS/FS/part_export/http_status.pm +++ b/FS/FS/part_export/http_status.pm @@ -4,9 +4,11 @@ use base qw( FS::part_export ); use strict; use warnings; use vars qw( %info $DEBUG ); +use URI::Escape; use LWP::UserAgent; use HTTP::Request::Common; use Email::Valid; +use Carp qw(carp); tie my %options, 'Tie::IxHash', 'url' => { label => 'URL', }, @@ -14,6 +16,9 @@ tie my %options, 'Tie::IxHash', 'blacklist_del_url' => { label => 'Optional blacklist delete URL', }, 'whitelist_add_url' => { label => 'Optional whitelist add URL', }, 'whitelist_del_url' => { label => 'Optional whitelist delete URL', }, + 'vacation_add_url' => { label => 'Optional vacation message add URL', }, + 'vacation_del_url' => { label => 'Optional vacation message delete URL', }, + #'user' => { label => 'Username', default=>'' }, #'password' => { label => 'Password', default => '' }, ; @@ -26,11 +31,12 @@ tie my %options, 'Tie::IxHash', 'notes' => <<'END' Fields from the service can be substituted in the URL as $field. -Optionally, spam black/whitelist addresses may be via HTTP or HTTPS as well. +Optionally, spam black/whitelist addresees and a vacation message may be +modified via HTTP or HTTPS as well. END ); -$DEBUG = 0; +$DEBUG = 1; sub rebless { shift; } @@ -39,9 +45,21 @@ our %addl_fields = ( 'svc_dsl' => [qw( gateway_access_or_phonenum ) ], ); +#some NOPs for required subroutines, to avoid throwing the exceptions in the +# part_export.pm fallbacks +sub _export_insert { '' }; +sub _export_replace { '' }; +sub _export_delete { '' }; + sub export_getstatus { my( $self, $svc_x, $htmlref, $hashref ) = @_; + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_getstatus() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + my $url; my $urlopt = $self->option('url'); no strict 'vars'; @@ -84,11 +102,23 @@ sub export_getstatus { my @fields = $csv->fields; my %hash = map { $_ => shift(@fields) } @header; - if ( $hash{'wb_value'} =~ /^[WA]/i ) { #Whitelist/Allow - push @{ $hashref->{'whitelist'} }, $hash{'from'}; - } else { # if ( $hash{'wb_value'} =~ /^[BD]/i ) { #Blacklist/Deny - push @{ $hashref->{'blacklist'} }, $hash{'from'}; + if ( defined $hash{'wb_value'} ) { + if ( $hash{'wb_value'} =~ /^[WA]/i ) { #Whitelist/Allow + push @{ $hashref->{'whitelist'} }, $hash{'from'}; + } else { # if ( $hash{'wb_value'} =~ /^[BD]/i ) { #Blacklist/Deny + push @{ $hashref->{'blacklist'} }, $hash{'from'}; + } + } + + for (qw( created enddate )) { + $hash{$_} = '' if $hash{$_} =~ /^0000-/; + $hash{$_} = (split(' ', $hash{$_}))[0]; } + + next unless $hash{'active'}; + $hashref->{"vacation_$_"} = $hash{$_} || '' + foreach qw( active subject body created enddate ); + } } #else { die 'guru meditation #295'; } @@ -106,7 +136,13 @@ sub export_setstatus_listdel { } sub export_setstatus_listX { - my( $self, $svc_x, $action, $list, $address ) = @_; + my( $self, $svc_x, $action, $list, $address_item ) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_setstatus_listX() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } my $option; if ( $list =~ /^[WA]/i ) { #Whitelist/Allow @@ -116,8 +152,16 @@ sub export_setstatus_listX { } $option .= $action. '_url'; - $address = Email::Valid->address($address) - or die "address failed $Email::Valid::Details check.\n"; + my $address; + unless ( $address = Email::Valid->address($address_item) ) { + + if ( $address_item =~ /^(\@[\w\-\.]+\.\w{2,63})$/ ) { # "@domain" + $address = $1; + } else { + die "address failed $Email::Valid::Details check.\n"; + } + + } #some false laziness w/export_getstatus above my $url; @@ -138,6 +182,56 @@ sub export_setstatus_listX { } -1; +sub export_setstatus_vacationadd { + my( $self, $svc_x, $hr ) = @_; + $self->export_setstatus_vacationX( $svc_x, 'add', $hr ); +} + +sub export_setstatus_vacationdel { + my( $self, $svc_x, $hr ) = @_; + $self->export_setstatus_vacationX( $svc_x, 'del', $hr ); +} + +sub export_setstatus_vacationX { + my( $self, $svc_x, $action, $hr ) = @_; + + if ( $FS::svc_Common::noexport_hack ) { + carp 'export_setstatus_vacationX() suppressed by noexport_hack' + if $self->option('debug') || $DEBUG; + return; + } + + my $option = 'vacation_'. $action. '_url'; + + my $subject = uri_escape($hr->{subject}); + my $body = uri_escape($hr->{body}); + for (qw( created enddate )) { + if ( $hr->{$_} =~ /^(\d{4}-\d{2}-\d{2})$/ ) { + $hr->{$_} = $1; + } else { + $hr->{$_} = ''; + } + } + my $created = $hr->{created}; + my $enddate = $hr->{enddate}; + + #some false laziness w/export_getstatus above + my $url; + my $urlopt = $self->option($option) or return; #DIFF + no strict 'vars'; + { + no strict 'refs'; + ${$_} = $svc_x->getfield($_) foreach $svc_x->fields; + ${$_} = $svc_x->$_() foreach @{ $addl_fields{ $svc_x->table } }; + $url = eval(qq("$urlopt")); + } + + my $req = HTTP::Request::Common::GET( $url ); + my $ua = LWP::UserAgent->new; + my $response = $ua->request($req); + + die $response->code. ' '. $response->message if $response->is_error; + +} 1;