DSL status pulling, RT#13656

3 files changed, 84 insertions, 0 deletions

diff --git a/FS/FS/part_export/http_status.pm b/FS/FS/part_export/http_status.pm
new file mode 100644
index 000000000..08be3a0d6
--- /dev/null
+++ b/FS/FS/part_export/http_status.pm
@@ -0,0 +1,49 @@
+packages FS::part_export::http_status;
+use base qw( FS::part_export );
+
+use strict;
+use warnings;
+use LWP::UserAgent;
+use HTTP::Request::Common;
+
+tie my %options, 'Tie::IxHash',
+  'url' => { label => 'URL', },
+  #'user'     => { label => 'Username', default=>'' },
+  #'password' => { label => 'Password', default => '' },
+;
+
+%info = (
+  'svc'     => 'svc_dsl',
+  'desc'    => 'Retrieve status information via HTTP or HTTPS',
+  'options' => \%options,
+  'notes'   => <<'END'
+Fields from the service can be substituted in the URL as $field.
+END
+);
+
+sub rebless { shift; }
+
+sub export_getstatus {
+  my( $self, $svc_x, $htmlref, $hashref ) = @_;
+
+  my $url = $self->option('url');
+  {
+    no strict 'refs';
+    ${$_} = $svc_x->getfield($x) foreach $svc_x->fields;
+
+    $url = eval(qq($url));
+  }
+
+  my $req = HTTP::Request::Common::GET( $url );
+  my $ua = LWP::UserAgent->new;
+  my $response = $ua->request($req);
+
+  $$htmlref = $response->is_error ? $response->error_as_HTML
+                                  : $response->content;
+
+
+  #hash data note yet implemented for this status export
+
+}
+
+1;
diff --git a/httemplate/view/svc_Status.html b/httemplate/view/svc_Status.html
new file mode 100644
index 000000000..94fa1e456
--- /dev/null
+++ b/httemplate/view/svc_Status.html
@@ -0,0 +1,22 @@
+<& /elements/header-popup.html,
+     {
+       'title'   => '',
+       'nobr'    => 0,  #1 for no <BR><BR> after the title
+     }
+&>
+% foreach my $export ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
+%   my $html = '';
+%   my %hash = ();
+%   $export->export_getstatus( $svc_x, \$html, \%hash );
+<% $html %>
+% }
+<%init>
+
+$cgi->param('svcnum') =~ /^(\d+)$/ or die 'illegal svcnum';
+my $svcnum = $1;
+
+my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $svcnum } );
+die "Unknown svcnum" unless $cust_svc;
+my $svc_x = $cust_svc->svc_x;
+
+</%init>
diff --git a/httemplate/view/svc_dsl.cgi b/httemplate/view/svc_dsl.cgi
index 477da268b..0b1ebd702 100644
--- a/httemplate/view/svc_dsl.cgi
+++ b/httemplate/view/svc_dsl.cgi
@@ -65,6 +65,19 @@ my $svc_cb = sub {
 
     }
 
+    if ( grep $_->can('export_getstatus'), $part_svc->part_export ) {
+
+      $footer .= '<BR><BR>'.
+                 include('/elements/popup_link.html', {
+                   'action' => $p.'view/svc_dsl_status.html'.
+                               '?svcnum='. $svc_dsl->svcnum,
+                   'label'  => 'View line status',
+                   'width'  => 763,
+                   'height' => 256,
+                 });
+
+    }
+
     $footer .= '<BR><BR>'.
                include( '/view/elements/svc_devices.html',
                           'svc_x'   => $svc_dsl,