1 package FS::part_export::http_status;
2 use base qw( FS::part_export );
6 use vars qw( %info $DEBUG );
9 use HTTP::Request::Common;
13 tie my %options, 'Tie::IxHash',
14 'url' => { label => 'URL', },
15 'blacklist_add_url' => { label => 'Optional blacklist add URL', },
16 'blacklist_del_url' => { label => 'Optional blacklist delete URL', },
17 'whitelist_add_url' => { label => 'Optional whitelist add URL', },
18 'whitelist_del_url' => { label => 'Optional whitelist delete URL', },
19 'vacation_add_url' => { label => 'Optional vacation message add URL', },
20 'vacation_del_url' => { label => 'Optional vacation message delete URL', },
22 #'user' => { label => 'Username', default=>'' },
23 #'password' => { label => 'Password', default => '' },
27 'svc' => [ 'svc_acct', 'svc_dsl', ],
28 'desc' => 'Retrieve status information via HTTP or HTTPS',
29 'options' => \%options,
32 Fields from the service can be substituted in the URL as $field.
34 Optionally, spam black/whitelist addresees and a vacation message may be
35 modified via HTTP or HTTPS as well.
41 sub rebless { shift; }
44 'svc_acct' => [qw( email ) ],
45 'svc_dsl' => [qw( gateway_access_or_phonenum ) ],
48 #some NOPs for required subroutines, to avoid throwing the exceptions in the
49 # part_export.pm fallbacks
50 sub _export_insert { '' };
51 sub _export_replace { '' };
52 sub _export_delete { '' };
54 sub export_getstatus {
55 my( $self, $svc_x, $htmlref, $hashref ) = @_;
57 if ( $FS::svc_Common::noexport_hack ) {
58 carp 'export_getstatus() suppressed by noexport_hack'
59 if $self->option('debug') || $DEBUG;
64 my $urlopt = $self->option('url');
68 ${$_} = $svc_x->getfield($_) foreach $svc_x->fields;
69 ${$_} = $svc_x->$_() foreach @{ $addl_fields{ $svc_x->table } };
70 $url = eval(qq("$urlopt"));
73 my $req = HTTP::Request::Common::GET( $url );
74 my $ua = LWP::UserAgent->new;
75 my $response = $ua->request($req);
77 if ( $svc_x->table eq 'svc_dsl' ) {
79 $$htmlref = $response->is_error ? $response->error_as_HTML
82 #hash data not yet implemented for svc_dsl
84 } elsif ( $svc_x->table eq 'svc_acct' ) {
86 #this whole section is rather specific to fibernetics and should be an
87 # option or callback or something
92 my $csv = Text::CSV_XS->new;
94 my @lines = split("\n", $response->content);
95 pop @lines if $lines[-1] eq '';
96 my $header = shift @lines;
97 $csv->parse($header) or return;
98 my @header = $csv->fields;
100 while ( my $line = shift @lines ) {
101 $csv->parse($line) or next;
102 my @fields = $csv->fields;
103 my %hash = map { $_ => shift(@fields) } @header;
105 if ( defined $hash{'wb_value'} ) {
106 if ( $hash{'wb_value'} =~ /^[WA]/i ) { #Whitelist/Allow
107 push @{ $hashref->{'whitelist'} }, $hash{'from'};
108 } else { # if ( $hash{'wb_value'} =~ /^[BD]/i ) { #Blacklist/Deny
109 push @{ $hashref->{'blacklist'} }, $hash{'from'};
113 for (qw( created enddate )) {
114 $hash{$_} = '' if $hash{$_} =~ /^0000-/;
115 $hash{$_} = (split(' ', $hash{$_}))[0];
118 next unless $hash{'active'};
119 $hashref->{"vacation_$_"} = $hash{$_} || ''
120 foreach qw( active subject body created enddate );
124 } #else { die 'guru meditation #295'; }
128 sub export_setstatus_listadd {
129 my( $self, $svc_x, $hr ) = @_;
130 $self->export_setstatus_listX( $svc_x, 'add', $hr->{list}, $hr->{address} );
133 sub export_setstatus_listdel {
134 my( $self, $svc_x, $hr ) = @_;
135 $self->export_setstatus_listX( $svc_x, 'del', $hr->{list}, $hr->{address} );
138 sub export_setstatus_listX {
139 my( $self, $svc_x, $action, $list, $address_item ) = @_;
141 if ( $FS::svc_Common::noexport_hack ) {
142 carp 'export_setstatus_listX() suppressed by noexport_hack'
143 if $self->option('debug') || $DEBUG;
148 if ( $list =~ /^[WA]/i ) { #Whitelist/Allow
149 $option = 'whitelist_';
150 } else { # if ( $hash{'wb_value'} =~ /^[BD]/i ) { #Blacklist/Deny
151 $option = 'blacklist_';
153 $option .= $action. '_url';
156 unless ( $address = Email::Valid->address($address_item) ) {
158 if ( $address_item =~ /^(\@[\w\-\.]+\.\w{2,63})$/ ) { # "@domain"
161 die "address failed $Email::Valid::Details check.\n";
166 #some false laziness w/export_getstatus above
168 my $urlopt = $self->option($option) or return; #DIFF
172 ${$_} = $svc_x->getfield($_) foreach $svc_x->fields;
173 ${$_} = $svc_x->$_() foreach @{ $addl_fields{ $svc_x->table } };
174 $url = eval(qq("$urlopt"));
177 my $req = HTTP::Request::Common::GET( $url );
178 my $ua = LWP::UserAgent->new;
179 my $response = $ua->request($req);
181 die $response->code. ' '. $response->message if $response->is_error;
185 sub export_setstatus_vacationadd {
186 my( $self, $svc_x, $hr ) = @_;
187 $self->export_setstatus_vacationX( $svc_x, 'add', $hr );
190 sub export_setstatus_vacationdel {
191 my( $self, $svc_x, $hr ) = @_;
192 $self->export_setstatus_vacationX( $svc_x, 'del', $hr );
195 sub export_setstatus_vacationX {
196 my( $self, $svc_x, $action, $hr ) = @_;
198 if ( $FS::svc_Common::noexport_hack ) {
199 carp 'export_setstatus_vacationX() suppressed by noexport_hack'
200 if $self->option('debug') || $DEBUG;
204 my $option = 'vacation_'. $action. '_url';
206 my $subject = uri_escape($hr->{subject});
207 my $body = uri_escape($hr->{body});
208 for (qw( created enddate )) {
209 if ( $hr->{$_} =~ /^(\d{4}-\d{2}-\d{2})$/ ) {
215 my $created = $hr->{created};
216 my $enddate = $hr->{enddate};
218 #some false laziness w/export_getstatus above
220 my $urlopt = $self->option($option) or return; #DIFF
224 ${$_} = $svc_x->getfield($_) foreach $svc_x->fields;
225 ${$_} = $svc_x->$_() foreach @{ $addl_fields{ $svc_x->table } };
226 $url = eval(qq("$urlopt"));
229 my $req = HTTP::Request::Common::GET( $url );
230 my $ua = LWP::UserAgent->new;
231 my $response = $ua->request($req);
233 die $response->code. ' '. $response->message if $response->is_error;