IMF-GEC11-QSR: ezclient.pl

#!/usr/bin/perl -w

use strict;
use warnings;

our $VERSION = 3.2;

=head1 NAME

dump.pl - Dumps the contents of an XMLDB.

=head1 DESCRIPTION

Given the information on an XMLDB, connect and dump all metadata and data
elements.

=head1 SYNOPSIS

    # this will send the xml file echo-req.xml to srv4.dir.garr.it on port 8080
    # and endpoint /axis/services/MeasurementArchiveService
    $ client.pl \
           http://srv4.dir.garr.it:8080/axis/services/MeasurementArchiveService \
           echo-req.xml

    # ditto
    $ client.pl \
           --server=srv4.dir.garr.it \
           --port=8080 \
           --endpoint=/axis/services/MeasurementArchiveService \
           echo-req.xml
               
    # this will override the port 8080 with the specified port 80
    $ client.pl \
           --port=80
           http://srv4.dir.garr.it:8080/axis/services/MeasurementArchiveService \
           echo-req.xml

    # this will override the endpoint with 
    # /perfsonar-RRDMA/services/MeasurementArchiveService
    $ client.pl \
           --endpoint=/perfsonar-RRDMA/services/MeasurementArchiveService
           http://srv4.dir.garr.it:8080/axis/services/MeasurementArchiveService \
           echo-req.xml
                
    # this will filter the output of the returned xml to only show the elements
    # that have qname nmwg:data
    $ client.pl \
           --filter='//nmwg:data' \
           http://srv4.dir.garr.it:8080/axis/services/MeasurementArchiveService \
           echo-req.xml
           
=cut

use Getopt::Long;
use Log::Log4perl qw(:easy);
use XML::LibXML;
use File::Basename;
use Carp;
use Params::Validate qw(:all);
use English qw( -no_match_vars );

use Time::Local;

my $dirname;
my $libdir;

# we need to figure out what the library is at compile time so that "use lib"
# doesn't fail. To do this, we enclose the calculation of it in a BEGIN block.
BEGIN {
    $dirname = dirname( $PROGRAM_NAME );
    $libdir  = $dirname . "/../lib";
}

use lib "$libdir";

use perfSONAR_PS::Transport;
use perfSONAR_PS::Common qw( readXML );
use perfSONAR_PS::Utils::ParameterValidation;

our $DEBUGFLAG;
our %opts = ();
our $help_needed;

my $ok = GetOptions(
    'filter=s'   => \$opts{FILTER},
        'device=s'               => \$opts{DEVICE},
        'start=s'                => \$opts{START},
        'end=s'          => \$opts{END},
        'type=s'                 => \$opts{TYPE},
        'interface=s'            => \$opts{INTERFACE},
        'plot'           => \$opts{PLOT},
    'help'       => \$help_needed
);

if ( not $ok or $help_needed ) {
    print_help();
    exit( 1 );
}

our $level = $INFO;
$level = $DEBUG if $DEBUGFLAG;

Log::Log4perl->easy_init( $level );
my $logger = get_logger( "perfSONAR_PS" );

my $host     = q{};
my $port     = q{};
my $endpoint = q{};
my $filter   = '/';
my $file     = q{};
my $starttime= q{};
my $endtime= q{};
my $montype= q{};
my $interface= q{};
my $device= q{};
my $devhost= q{};
if ( scalar @ARGV == 1 ) {
    ( $host, $port, $endpoint ) = &perfSONAR_PS::Transport::splitURI( $ARGV[0] );

    unless ( $host and $port and $endpoint ) {
        print_help();
        croak "Argument 1 must be a URI if more than one parameter used.\n";
    }

}
else {
    print_help();
    croak "Invalid number of parameters: must be 1 for a uri";
}

my $syear = q {};
my $smon = q {};
my $sday = q {};
my $shour = q {};
my $smin = q {};
my $ssec = q {};
my $eyear = q {};
my $emon = q {};
my $eday = q {};
my $ehour = q {};
my $emin = q {};
my $esec = q {};

if ( defined $opts{HOST} ) {
    $host = $opts{HOST};
}
if ( defined $opts{PORT} ) {
    $port = $opts{PORT};
}
if ( defined $opts{ENDPOINT} ) {
    $endpoint = $opts{ENDPOINT};
}
if ( defined $opts{FILTER} ) {
    $filter = $opts{FILTER};
}
if ( defined $opts{START} ) {
        ($syear,$smon,$sday,$shour,$smin,$ssec)=split(":",$opts{START});
        $shour=0 if not defined $shour;
        $smin=0 if not defined $smin;
        $ssec=0 if not defined $ssec;
        $starttime = timegm($ssec,$smin,$shour,$sday,($smon-1),$syear); 
    #$starttime= $opts{START};
}
if ( defined $opts{END} ) {
        ($eyear,$emon,$eday,$ehour,$emin,$esec)=split(":",$opts{END});
        $ehour=0 if not defined $ehour;
        $emin=0 if not defined $emin;
        $esec=0 if not defined $esec;
        $endtime = timegm($esec,$emin,$ehour,$eday,($emon-1),$eyear); 
    #$endtime= $opts{END};
}
if ( defined $opts{TYPE} ) {
    $montype= $opts{TYPE};
}
if ( defined $opts{INTERFACE} ) {
    $interface= $opts{INTERFACE};
}
if ( defined $opts{DEVICE} ) {
    ($device,$devhost)= split(':',$opts{DEVICE});
}

unless ( $host and $port and $endpoint ) {
    print_help();
    croak "You must specify the host, port and endpoint as either a URI or via the command line switches";
}
my $id=0;

my $xmlf;
if (uc $device eq 'INFINERA') {
        if (uc $montype eq 'BER'){
                $montype="PREFEC-".$montype ;
        #       $id=8;
        }
        elsif (uc $montype eq 'POWER'){
        #       $id=7
        }
        else {
                print "Currently only BER and POWER measurements are supported.\n";
        }
        my ($port1,$port2,$port3)=split(':',$interface);
        $xmlf="<nmwgt:device>INFINERA</nmwgt:device>
                                <nmwgt:montype>$montype</nmwgt:montype>
                                <nmwgt:hostName>$devhost</nmwgt:hostName>
                                <nmwgt:hostPort>9090</nmwgt:hostPort>
                 <layer0:port>
                         <layer0:chassis>$port1</layer0:chassis>
                         <layer0:DLMslot>$port2</layer0:DLMslot>
                         <layer0:opticalChannel>$port3</layer0:opticalChannel>
                 </layer0:port>\n";
        }
elsif (uc $device eq 'POLATIS'){
        $xmlf="<nmwgt:device>POLATIS</nmwgt:device>
                                <nmwgt:montype>$montype</nmwgt:montype>
                                <nmwgt:hostName>$devhost</nmwgt:hostName>
                                <nmwgt:hostPort>3082</nmwgt:hostPort>
                 <layer0:port>
                         <layer0:opticalPort>$interface</layer0:opticalPort>
                 </layer0:port>\n";
        }
else {
        print "Currently only INFINERA and POLATIS devices are supported.\n";
        }

my $xmlf_header="<nmwg:message xmlns:nmwg=\"http://ggf.org/ns/nmwg/base/2.0/\" 
     xmlns:ber=\"http://ggf.org/ns/nmwg/characteristic/BER/2.0\"
     xmlns:power=\"http://ggf.org/ns/nmwg/characteristic/POWER/2.0\"
     xmlns:nmwgt=\"http://ggf.org/ns/nmwg/topology/2.0/\"
     xmlns:unis=\"http://ogf.org/schema/network/topology/unis/20100528/\"
     xmlns:layer0=\"http://ggf.org/ns/nmwg/topology/layer0/2.0/\"
         type=\"SetupDataRequest\" 
         id=\"setupDataRequest1\" >
  <nmwg:metadata id=\"m-$id\" xmlns:nmwg=\"http://ggf.org/ns/nmwg/base/2.0/\">
    <nmwg:subject id=\"sub1\">
                <nmwgt:interface xmlns:nmwgt=\"http://ggf.org/ns/nmwg/topology/2.0/\">
                        <nmwgt:node>\n";
my $xmlf_tail="</nmwgt:node>
                </nmwgt:interface>
    </nmwg:subject>
        <nmwg:eventType>http://ggf.org/ns/nmwg/characteristic/$montype/2.0</nmwg:eventType>
  </nmwg:metadata> 
  <nmwg:metadata id=\"m-${id}c\" xmlns:nmwg=\"http://ggf.org/ns/nmwg/base/2.0/\">
    <select:subject id=\"sub1c\" metadataIdRef=\"m-$id\" xmlns:select=\"http://ggf.org/ns/nmwg/ops/select/2.0/\"/> 
    <select:parameters id=\"param2c\" xmlns:select=\"http://ggf.org/ns/nmwg/ops/select/2.0/\">      
      <nmwg:parameter name=\"startTime\">$starttime</nmwg:parameter>
      <nmwg:parameter name=\"endTime\">$endtime</nmwg:parameter>
    </select:parameters>
    <nmwg:eventType>http://ggf.org/ns/nmwg/ops/select/2.0</nmwg:eventType> 
  </nmwg:metadata>
  <nmwg:data id=\"d-$id\" metadataIdRef=\"m-${id}c\" xmlns:nmwg=\"http://ggf.org/ns/nmwg/base/2.0/\"/>

</nmwg:message>\n ";

# start a transport agent
my $sender = new perfSONAR_PS::Transport( $host, $port, $endpoint );

# Make a SOAP envelope, use the XML file as the body.
my $envelope = &perfSONAR_PS::Common::makeEnvelope( $xmlf_header.$xmlf.$xmlf_tail );
my $error;

# Send/receive to the server, store the response for later processing
my $responseContent = $sender->sendReceive( $envelope, q{}, \$error );

croak "Error sending request to service: $error" if $error;

# dump the content to screen, using the xpath statement if necessary
&dump( { response => $responseContent, find => $filter } );

exit( 0 );

=head2 dump( { response, find } )

Print out results of service message.  

=cut

sub dump {
    my ( @args ) = @_;
    my $parameters = validateParams( @args, { response => 1, find => 1 } );
    my $xp = q{};

    if ( ( UNIVERSAL::can( $parameters->{response}, "isa" ) ? 1 : 0 == 1 ) and ( $xmlf->isa( 'XML::LibXML' ) ) ) {
        $xp = $parameters->{response};
    }
    else {
        my $parser = XML::LibXML->new();
        $xp = $parser->parse_string( $parameters->{response} );
    }
    my @res = $xp->findnodes( $parameters->{find} );
        my @s;
    foreach my $n ( @res ) {
                $_=$n->toString();
                 @s=  m/Value="(.*?)".*startTime="(.*?)"/g;
        #print $n->toString() . "\n";
    }
        my $v=undef;
        if (defined $opts{PLOT}){
                open FILE, ">temp" or die $!;
        }
        foreach (@s){
                if ( not defined $v ) {
                        $v=$_;
                        #print $_."\n";
                }
                else {
                        if (defined $opts{PLOT}){
                                if (uc $montype eq 'POWER'){
                                $_=$_." : ".$v;
                                        s/.*?\s(.*?)\s(.*?)\s(.*?)\s.*?:(.*?)dB/$1-$2-$3 $4/;   
                                }
                                elsif (uc $montype eq 'PREFEC-BER'){
                                $_=$_." : ".log($v);
                                        s/.*?\s(.*?)\s(.*?)\s(.*?)\s.*?:(.*?)/$1-$2-$3 $4/;     
                                }
                                print FILE $_."\n";
                        }
                        else {
                                print $_." : ".$v."\n";
                        }
                        $v=undef;
                }
        }
if (defined $opts{PLOT}){
close FILE;
my %months = (1=>"Jan",2=>"Feb",3=>"Mar",4=>"Apr",5=>"May",6=>"Jun",7=>"Jul",8=>"Aug",9=>"Sep",10=>"Oct",11=>"Nov",12=>"Dec");
#print "$months{$smon}-$sday-$shour:$smin:00"."$months{$emon}-$eday-$ehour:$emin:00";
        open (GNUPLOT, "|gnuplot");
        if (uc $montype eq 'POWER'){
        print GNUPLOT<<EOF;
set term x11
set xdata time
set timefmt "%b-%d-%H:%M:%S"
set output "load.png"
set xrange ["$months{$smon}-$sday-$shour:$smin:00":"$months{$emon}-$eday-$ehour:$emin:00"]
set yrange [0:-50]
set grid
set xlabel "Date\\nTime"
set ylabel "$montype"
set title "$device-$devhost"
plot "temp" using 1:2 index 0 title "port: $interface" with lines
 pause 30
EOF
}
        elsif (uc $montype eq 'PREFEC-BER'){
        print GNUPLOT<<EOF;
set term x11
set xdata time
set timefmt "%b-%d-%H:%M:%S"
set output "load.png"
set xrange ["$months{$smon}-$sday-$shour:$smin:00":"$months{$emon}-$eday-$ehour:$emin:00"]
set yrange [0:-30]
set grid
set xlabel "Date\\nTime"
set ylabel "$montype (BER=2^y)"
set title "$device-$devhost"
plot "temp" using 1:2 index 0 title "port: $interface" with lines
 pause 30
EOF
}
close(GNUPLOT);
}
    return;
}

=head2 help()

Print a help message

=cut

sub print_help {
    print "$PROGRAM_NAME: sends an xml file to the server on specified port.\n";
    print "    ./client.pl  http://xxx.yyy.zzz:9989/perfSONAR_PS/services/IMFRealTime --device=infinera:dtn-1.renci.ben --start=year:mon:day:hour:sec --end=year:mon:day:hour:sec --type=BER --interface=1:4:9 \n";
    return;
}

__END__

=head1 SEE ALSO

L<use Getopt::Long>, L<perfSONAR_PS::DB::XMLDB>

To join the 'perfSONAR Users' mailing list, please visit:

  https://lists.internet2.edu/sympa/info/perfsonar-ps-users

The perfSONAR-PS subversion repository is located at:

  http://anonsvn.internet2.edu/svn/perfSONAR-PS/trunk

Questions and comments can be directed to the author, or the mailing list.
Bugs, feature requests, and improvements can be directed here:

  http://code.google.com/p/perfsonar-ps/issues/list

=head1 VERSION

$Id: client.pl 4475 2010-09-29 13:18:06Z zurawski $

=head1 AUTHOR

Jason Zurawski, zurawski@internet2.edu
Yee-Ting Li <ytl@slac.stanford.edu>

=head1 LICENSE

You should have received a copy of the Internet2 Intellectual Property Framework
along with this software.  If not, see
<http://www.internet2.edu/membership/ip.html>

=head1 COPYRIGHT

Copyright (c) 2004-2010, Internet2 and the University of Delaware

All rights reserved.

=cut