#! /usr/bin/perl use strict ; use warnings ; package Probe::Generic ; use JSON::PP ; use LWP::UserAgent ; use base 'Probe' ; sub ITEMS { [] ; } ; # item args : ( RUN prog args | GET url ) [ PICK args ] # default PICK = $item -> name sub do_run { my $what = shift ; my $data ; my ( $err, $xit, $sig, @lines ) = Probe::Util::run_prog ( @$what ) ; unless ( $err ) { $data = {} ; for my $line ( @lines ) { chomp $line ; my ( $key, $val ) = split ' ', $line ; $data -> { $key } = $val ; } } [ $err, $data ] ; } sub do_get { my $what = shift ; my $data ; my $err ; my $ua = LWP::UserAgent->new ; my $response = $ua->get ( $what -> [ 0 ] ) ; if ( $response -> is_success ) { my $text = $response -> decoded_content ; $data = decode_json $text ; } else { $err = $response -> status_line ; } [ $err, $data ] ; } sub get { my $type = shift ; my $what = shift ; ( $type eq 'RUN' ? do_run $what : do_get $what ) ; } sub pick { my $data = shift ; my $pick = shift ; my $val = $data ; for my $tag ( @$pick ) { $val = $val -> { $tag } ; } $val ; } sub main { my $self = shift ; my $itms = shift ; # items to probe : [ item, ... ] my $clnt = shift ; # main::CLIENT my $DATA = {} ; for my $item ( @$itms ) { my $name = $item -> name ; my @args = @{ $item -> args } ; my $stat = 'init' ; my $err = '' ; my $type ; my $what ; my $pick ; for my $arg ( @args ) { OBB::TT ( ' state %s arg %s', $stat, $arg ) ; if ( $stat eq 'init' ) { if ( $arg !~ /^RUN|GET$/ ) { $err = "no GET|RUN" ; } else { $type = $arg ; $what = [] ; $stat = 'what' ; } } elsif ( $stat eq 'what' ) { if ( $arg eq 'PICK' ) { $pick = [] ; $stat = 'pick' ; } else { push @$what, $arg ; } } elsif ( $stat eq 'pick' ) { push @$pick, $arg ; } else { $err = "bad state $stat [@args]" ; } last if $err ; } $err = 'incomplete' unless $err or $stat =~ /^args|pick$/ ; $err = "$type what?" unless $err or @$what ; $pick = [ $name ] unless $pick ; if ( $err ) { OBB::TT ( " err: name %d, err %s what %s pick %s" , $name, $err, "@$what", "@$pick" ) ; $item -> perr ( $err ) ; next ; } my $WHAT = join '|', @$what ; unless ( exists $DATA -> { $WHAT } ) { $DATA -> { $WHAT } = get $type, $what ; } my $perr = $DATA -> { $WHAT } [ 0 ] ; my $data = $DATA -> { $WHAT } [ 1 ] ; if ( $perr ) { OBB::TT ( ' name %s perr %s', $name, $perr ) ; $item -> perr ( $perr ) ; } elsif ( $data ) { my $val = pick $data, $pick ; $item -> set_val ( $val ) ; } else { OBB::TT ( ' no data ; WHAT %s', $WHAT ) ; $item -> perr ( 'no data?' ) ; } } } 1 ;