#!/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="INFINERA
$montype
$devhost
9090
$port1
$port2
$port3
\n";
}
elsif (uc $device eq 'POLATIS'){
$xmlf="POLATIS
$montype
$devhost
3082
$interface
\n";
}
else {
print "Currently only INFINERA and POLATIS devices are supported.\n";
}
my $xmlf_header="
\n";
my $xmlf_tail="
http://ggf.org/ns/nmwg/characteristic/$montype/2.0
$starttime
$endtime
http://ggf.org/ns/nmwg/ops/select/2.0
\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<, L
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
=head1 LICENSE
You should have received a copy of the Internet2 Intellectual Property Framework
along with this software. If not, see
=head1 COPYRIGHT
Copyright (c) 2004-2010, Internet2 and the University of Delaware
All rights reserved.
=cut