Open MPI logo

MTT Devel Mailing List Archives

  |   Home   |   Support   |   FAQ   |   all MTT Devel mailing list

Subject: Re: [MTT devel] [MTT svn] svn:mtt-svn r1481 - in trunk: client lib/MTT/Reporter
From: Jeff Squyres (jsquyres_at_[hidden])
Date: 2012-08-01 07:00:49


Mike --

MongoDB is a NoSQL thingy, right?

Can you describe this plugin a bit? Do you guys have some kind of reporter for MongoDB?

On Aug 1, 2012, at 5:46 AM, <svn-commit-mailer_at_[hidden]> wrote:

> Author: miked (Mike Dubman)
> Date: 2012-08-01 05:46:03 EDT (Wed, 01 Aug 2012)
> New Revision: 1481
> URL: https://svn.open-mpi.org/trac/mtt/changeset/1481
>
> Log:
> add modified version mongobquery and MTTMongodb
>
> Added:
> trunk/client/mongobquery.pl (contents, props changed)
> trunk/lib/MTT/Reporter/MTTMongodb.pm
>
> Added: trunk/client/mongobquery.pl
> ==============================================================================
> --- /dev/null 00:00:00 1970 (empty, because file is newly added)
> +++ trunk/client/mongobquery.pl 2012-08-01 05:46:03 EDT (Wed, 01 Aug 2012) (r1481)
> @@ -0,0 +1,1018 @@
> +#!/usr/bin/perl
> +#
> +# Copyright (c) 2009
> +# $COPYRIGHT$
> +#
> +# Additional copyrights may follow
> +#
> +# $HEADER$
> +#
> +# Now that @INC is setup, bring in the modules
> +
> +#use strict;
> +#use warnings;
> +use LWP::UserAgent;
> +use HTTP::Request::Common;
> +use Data::Dumper;
> +use File::Basename;
> +use File::Temp;
> +use Config::IniFiles;
> +use YAML::XS;
> +use MongoDB;
> +use MongoDB::OID;
> +use YAML;
> +use YAML::Syck;
> +use DateTime;
> +
> +###########################################################
> +# Set variables
> +###########################################################
> +my $module_name=$0;
> +my $module_path=$0;
> +
> +$module_name=~s/([^\/\\]+)$//;
> +$module_name=$1;
> +
> +$module_path=~s/([^\/\\]+)$//;
> +
> +
> +###########################################################
> +# Main block
> +###########################################################
> +use Getopt::Long qw(:config no_ignore_case);
> +
> +my $opt_help;
> +my $opt_server;
> +my $opt_username;
> +my $opt_password;
> +
> +my $opt_ping;
> +my $opt_upload;
> +my $opt_query;
> +my $opt_view;
> +my $opt_admin;
> +
> +my @opt_data;
> +my @opt_raw;
> +
> +my $opt_gqls;
> +my @opt_gqlf;
> +my @opt_section;
> +my $opt_dir;
> +my $opt_no_raw;
> +
> +my $opt_dstore;
> +my $opt_info;
> +my $opt_format;
> +my $opt_mailto;
> +my $opt_regression_from;
> +my $opt_regression_to;
> +my $opt_regression_step;
> +
> +my @opt_newuser;
> +
> +GetOptions ("help|h" => \$opt_help,
> + "server|a=s" => \$opt_server,
> + "username|u=s" => \$opt_username,
> + "password|p=s" => \$opt_password,
> + "ping" => \$opt_ping,
> + "upload" => \$opt_upload,
> + "query" => \$opt_query,
> + "view" => \$opt_view,
> + "admin" => \$opt_admin,
> +
> + "data|S=s" => \@opt_data,
> + "raw|R=s" => \@opt_raw,
> +
> + "gqls|L=s" => \$opt_gqls,
> + "gqlf|F=s" => \@opt_gqlf,
> + "section|T=s" => \@opt_section,
> + "dir|O=s" => \$opt_dir,
> + "no-raw" => \$opt_no_raw,
> +
> + "dstore|D" => \$opt_dstore,
> + "info|I=s" => \$opt_info,
> + "format|V=s" => \$opt_format,
> + "email|e=s" => \$opt_mailto,
> +
> + "newuser=s{3,5}" => \@opt_newuser,
> +
> + "regression-from=s" => \$opt_regression_from,
> + "regression-to=s" => \$opt_regression_to,
> + "regression-step=s" => \$opt_regression_step
> + );
> +
> +
> +my $url = ();
> +my $username = ();
> +my $password = ();
> +
> +$url = $opt_server ? $opt_server : "http://bgate.mellanox.com:27017";
> +$url =~ s/http:\/\///;
> +$username = $opt_username ? $opt_username : "admin";
> +$password = $opt_password ? $opt_password : "";
> +
> +my %conf = ('url' => "$url\/client",
> + 'username' => $username,
> + 'password' => $password
> + );
> +
> +if ($opt_help)
> +{
> + my $action = '';
> +
> + $action = 'ping' if ($opt_ping);
> + $action = 'upload' if ($opt_upload);
> + $action = 'query' if ($opt_query);
> + $action = 'view' if ($opt_view);
> + $action = 'admin' if ($opt_admin);
> +
> + help($action);
> +
> + exit;
> +}
> +elsif ($opt_ping)
> +{
> + #ping( \%conf );
> + #print $url," url\n";
> + my $conn = MongoDB::Connection->new(host => $url );
> + if($conn != 0)
> + {
> + print"\n\nping: success\n\n";
> + }
> +}
> +elsif ($opt_upload)
> +{
> + if ($#opt_data < 0)
> + {
> + help('upload');
> + }
> + my @data = split(/,/,join(',',@opt_data)) if (@opt_data);
> + my @raw = split(/,/,join(',',@opt_raw)) if (@opt_raw);
> +
> + # Check if files existed
> + verify_opt_file( @data );
> + verify_opt_file( @raw );
> +
> + $conf{data} = \@data;
> + $conf{raw} = \@raw;
> +
> + upload( \%conf );
> +}
> +elsif ($opt_query)
> +{
> + my $gql = ();
> + if ($opt_gqls)
> + {
> + $gql = $opt_gqls;
> + }
> + else
> + {
> + help('query');
> + }
> + #print $gql, " before\n";
> + $gql =~ s/\s+/ /g;
> + $gql =~ s/ /#/g;
> + $gql =~ s/And/AND/g;
> + $gql =~ s/and/AND/g;
> + $gql =~ s/Or/OR/g;
> + $gql =~ s/or/OR/g;
> + $gql =~ s/#In#/IN/g;
> + $gql =~ s/#in#/IN/g;
> + $gql =~ s/Not/NOT/g;
> + $gql =~ s/not/NOT/g;
> + $gql =~ s/#AND#/ AND /g;
> + $gql =~ s/#OR#/ \| /g;
> + #$gql =~ s/#IN#/IN/g;
> + $gql =~ s/#NOT/NOT/g;
> + $gql =~ s/#=#/=/g;
> + $gql =~ s/#>#/>/g;
> + $gql =~ s/#>=#/>=/g;
> + $gql =~ s/#<#/</g;
> + $gql =~ s/#<=#/<=/g;
> + #print $gql," after\n";
> + #exit;
> +
> + my @date_array;
> + if($gql =~ m/=>|=</)
> + {
> + print "\nError:\nInvalid format: \"=>\" or \"=<\"\nUse \">=\" or \"<=\" instead\n";
> + exit;
> + }
> +
> + if($opt_regression_step)
> + {
> + if($opt_regression_step =~ m/^\d{4}-\d{2}-\d{2}$/)
> + {
> + #print "ok $opt_regression_step \n";
> + }else
> + {
> + die "\nparametr \"regression-step\" has invalid format. YYYY-MM-DD\nexample --regression-step=\'0000-01-03\'";
> + }
> +
> + if($gql =~ m/TestRunPhase\.start_time/)
> + {
> + $str_start_time = $';
> + if($str_start_time =~ m/\d{4}-\d{2}-\d{2}#\d{2}:\d{2}:\d{2}/)
> + {
> + $str_start_time = $&;
> + }else
> + {
> + die "synrax error";
> + }
> + }else
> + {
> + die "syntax error";
> + }
> +
> + if($gql =~ m/TestRunPhase\.end_time/)
> + {
> + $str_end_time = $';
> + if($str_end_time =~ m/\d{4}-\d{2}-\d{2}#\d{2}:\d{2}:\d{2}/)
> + {
> + $str_end_time = $&;
> + }else
> + {
> + die "syntax error";
> + }
> + }else
> + {
> + die "syntax error";
> + }
> +
> + #print "start_time $str_start_time end_time $str_end_time \n";
> +
> + my $timezone = DateTime->now;
> +
> + @numbers = split(/:|-|#/,$str_start_time);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + my %hash_start_time = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> $timezone->time_zone());
> + my $DateTime_start_time = DateTime->new(%hash_start_time);
> +
> + @numbers = split(/:|-|#/,$str_end_time);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + my %hash_end_time = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> $timezone->time_zone());
> + my $DateTime_end_time = DateTime->new(%hash_end_time);
> +
> +
> + print "\n\nacceptable dates:\n";
> + my $count = 1;
> + my @arg_to_subtract = split(/-/,$opt_regression_step);
> + #print "\n\n_at_arg_to_subtract\n\n";
> + while(DateTime->compare( $DateTime_start_time, $DateTime_end_time )!=1)
> + {
> +
> + $DateTime_end_time->subtract(years=> @arg_to_subtract[0],months=>@arg_to_subtract[1],days =>@arg_to_subtract[2]);
> + my $month = $DateTime_end_time->month();
> + my $day = $DateTime_end_time->day();
> + if(!($day =~ m/\d{2}/))
> + {
> + $day = "0".$day;
> + }
> + if(!($month =~ m/\d{2}/))
> + {
> + $month = "0".$month;
> + }
> + $str = $DateTime_end_time->year() . "-" . $month . "-" . $day;
> + push(@date_array,$str);
> + print "$str ";
> + if($count % 7 == 0)
> + {
> + print"\n";
> + }
> + $count++;
> +
> + }
> + #print"\n\n @date_array\n\n";
> + }
> + #print "hash start_time ", $DateTime_start_time, " hash end_time ", $DateTime_end_time, "\n";
> + #print "time zone ",$timezone,"\n";
> +
> + my $query_to_mongo = string2query($gql);
> + $query_to_mongo .= ";";
> + print "\n\n**********************************************************************query to mongo*************************************************************************";
> + print "\n",$query_to_mongo,"\n";
> + print "*************************************************************************************************************************************************************\n";
> + ######################################################################
> + #mongo
> + #######################################################################
> + my $conn = MongoDB::Connection->new(host => $url);
> + my $db = $conn->mtt;
> + my $mtt_result = $db->TestRunPhase;
> + my $all_result = $mtt_result->find(eval $query_to_mongo);
> + my $i = 0;
> + if($opt_regression_step)
> + {
> + while (my $doc = $all_result->next)
> + {
> + if($doc->{"modules"}->{"TestRunPhase"}->{"start_time"} =~ m/\d{4}-\d{2}-\d{2}/)
> + {
> + if ($& ~~ @date_array)
> + {
> + open F, '>', "$i.yaml";
> + print F YAML::Syck::Dump( $doc );
> + close F;
> + $i++;
> + }
> + }
> + else
> + {
> + die "something strange happened";
> + }
> +
> + }
> + }else
> + {
> + while (my $doc = $all_result->next)
> + {
> +
> + open F, '>', "$i.yaml";
> + print F YAML::Syck::Dump( $doc );
> + close F;
> + $i++;
> + }
> +
> + }
> + print "found $i documents\n";
> + ######################################################################
> + #mongo
> + ######################################################################
> +
> +}
> +elsif ($opt_view)
> +{
> + if ($opt_gqls)
> + {
> + # $conf{gql} = $opt_gqls;
> + }
> + elsif (@opt_gqlf && @opt_section && (@opt_gqlf == @opt_section))
> + {
> + # my $gql = ();
> + # my @a_select;
> + # my $v_from;
> + # my @a_where;
> + # my @a_order;
> + # my $v_limit;
> + # my $v_offset;
> + # my $i = 0;
> + #
> + # my @files=split(/,/,join(',',@opt_gqlf)) if (@opt_gqlf);
> + # my @sections=split(/,/,join(',',@opt_section)) if (@opt_section);
> + #
> + # # Check if files existed
> + # verify_opt_file( @files );
> + #
> + # for($i=0; $i < @files; $i++)
> + # {
> + # # Use ini-file in case it is set in command line
> + # my $cfg = new Config::IniFiles( -file => "$files[$i]", -nocase => 1 );
> + # if (not defined $cfg or $@)
> + # {
> + # die "$!";
> + # }
> + # $opt_format = $cfg->val("$sections[$i]", 'format') if ($cfg->val("$sections[$i]", 'format'));
> + #
> + # my @a_temp_select = $cfg->val("$sections[$i]", 'select') if ($cfg->val("$sections[$i]", 'select'));
> + # my $v_temp_from = $cfg->val("$sections[$i]", 'from') if ($cfg->val("$sections[$i]", 'from'));
> + # my @a_temp_where = $cfg->val("$sections[$i]", 'where') if ($cfg->val("$sections[$i]", 'where'));
> + # my @a_temp_order = $cfg->val("$sections[$i]", 'order') if ($cfg->val("$sections[$i]", 'order'));
> + # my $v_temp_limit = $cfg->val("$sections[$i]", 'limit') if ($cfg->val("$sections[$i]", 'limit'));
> + # my $v_temp_offset = $cfg->val("$sections[$i]", 'offset') if ($cfg->val("$sections[$i]", 'offset'));
> +
> + # @a_select = @a_temp_select if ($#a_temp_select != (-1));
> + # $v_from = $v_temp_from if ($v_temp_from);
> + # my $j = 0;
> + # my $k = 0;
> + # for ($j = 0; $j < scalar(@a_where); $j++)
> + # {
> + # for ($k = 0; $k < scalar(@a_temp_where); $k++)
> + # {
> + # if ($a_temp_where[$k])
> + # {
> + # $a_temp_where[$k] =~ m/^\s*(\w+)/i;
> + # if (grep /^\s*$1/, $a_where[$j])
> + # {
> + # $a_where[$j] = $a_temp_where[$k];
> + # delete($a_temp_where[$k]);
> + # next;
> + # }
> + # }
> + # }
> + # }
> + # foreach (@a_temp_where)
> + # {
> + # push(@a_where, $_) if ($_);
> + # }
> + #
> + # @a_order = @a_temp_order if ($#a_temp_order != (-1));
> + # $v_limit = $v_temp_limit if ($v_temp_limit);
> + # $v_offset = $v_temp_offset if ($v_temp_offset);
> + # }
> + #
> + # $gql = '';
> + # $gql .= ' select ' . join(',',@a_select) if (@a_select);
> + # $gql .= ' from ' . $v_from if ($v_from);
> + # $gql .= ' where ' . join(' and ',@a_where) if (@a_where);
> + # $gql .= ' order by ' . join(',',@a_order) if (@a_order);
> + # $gql .= ' limit ' . $v_limit if ($v_limit);
> + # $gql .= ' offset ' . $v_offset if ($v_offset);
> + #
> + # $conf{gql} = $gql;
> + #
> +
> + print "this feature temporarily unavailable\n";
> + exit;
> + }
> + elsif ($opt_dstore)
> + {
> + $conf{kind} = 'all';
> + }
> + elsif ($opt_info)
> + {
> + $conf{kind} = $opt_info;
> + }
> + else
> + {
> + help('view');
> + }
> +
> + if ($opt_format)
> + {
> + foreach my $format qw(raw txt html yaml)
> + {
> + $conf{format} = $format if ($opt_format eq $format) ;
> + }
> + }
> + $conf{format} = 'raw' if (!exists($conf{format})) ;
> +
> + view( \%conf );
> +}
> +elsif ($opt_admin)
> +{
> +
> + print "this feature temporarily unavailable\n";
> + exit;
> + #if ($#opt_newuser > 0)
> + #{
> + # $conf{newuser} = \@opt_newuser;
> + #}
> + #admin( \%conf );
> +}
> +else
> +{
> + help();
> + exit;
> +}
> +
> +
> +# Send notification by e-mail
> +if ( $opt_mailto ) {
> +# send_results_by_mail($opt_mailto, @files);
> +}
> +
> +
> +###############################################################################
> +# Define functions
> +###############################################################################
> +
> +###############################################################################
> +#
> +#convert string to query
> +#
> +###############################################################################
> +
> +sub string2query
> +{
> + my $gql = $_[0];
> + my $before;
> + my $after;
> + my $match_case;
> + while($gql =~ m/\([^\(\)]+(=|>=|<=|<|>|IN\([^\(\)]+\))+[^\(\)]+\)/)
> + {
> + $before = $`;
> + $after = $';
> + $match_case = $&;
> + chop($match_case);
> + $match_case = reverse($match_case);
> + chop($match_case);
> + $match_case = reverse($match_case);
> + #print "() before: ",$before," after: ",$after," match case: ",$match_case,"\n";
> + #<STDIN>;
> + $gql = $before . string2query($match_case) . $after;
> + #print "gql after: ",$gql,"\n";
> + }
> + if($gql =~ m/\|/ && $gql =~ m/AND/)
> + {
> +
> + while($gql =~ m/[^\|]+(AND)+[^\|]+/)
> + {
> + $before = $`;
> + $after = $';
> + $match_case = $&;
> + #chop($match_case);
> + #$match_case = reverse($match_case);
> + #chop($match_case);
> + #$match_case = reverse($match_case);
> +
> + #print "AND OR before: ",$before," after: ",$after," match case: ",$match_case,"\n";
> + #<STDIN>;
> + $gql = $before . string2query($match_case) . $after;
> + #print "gql after: ",$gql,"\n";
> + }
> + }
> +
> + #print "lowest level: ",$gql,"\n";
> + #<STDIN>;
> + $gql = string2query_lowest($gql);
> + #print "gql after: ",$gql,"\n";
> +
> + return $gql;
> +}
> +
> +###############################################################################
> +#
> +#convert string to query (lowest level)
> +#
> +###############################################################################
> +sub string2query_lowest
> +{
> + my $input_string = $_[0];
> + my @subs = split(/\s/,$input_string);
> + my $arg;
> + my $query_to_mongo = " {";
> + my $before;
> + my $after;
> + my $match_case;
> + #my $prefix = "modules.TestRunPhase.";
> + my $prefix = "modules.";
> + if($input_string =~ m/AND/ && $input_string =~ m/\|/)
> + {
> + print "error: bquery lowest level\n";
> + print "input string: ",$input_string,"\n";
> + die;
> + }elsif($input_string =~ m/\|/)
> + {
> + $query_to_mongo .= "\'\$or\'=>[";
> + }else
> + {
> + $query_to_mongo .= "\'\$and\'=>[";
> + }
> + foreach $arg(@subs)
> + {
> + #print $arg," subs\n";
> + }
> + foreach $arg(@subs)
> + {
> + $arg =~ s/#/ /g;
> +
> + if($arg =~m/>=|<=|NOTIN/)
> + {
> + #print "before match: ", $before,", after match: ",$after," match case: ",$match_case,"\n";
> + $before ="{\'$prefix" . $` . "\'=>";
> + $after = $';
> + $match_case = $&;
> + if($match_case eq ">=")
> + {
> + #print "bolshe ili ravno\n";
> + $query_to_mongo .= $before . "{\'\$gte\'=>" . $after . "}},";
> +
> + }elsif($match_case eq "<=")
> + {
> + #print "menshe ili ravno\n";
> + $query_to_mongo .= $before . "{\'\$lte\'=>" . $after . "}},";
> +
> + }else
> + {
> + #print "NIN\n";
> + $after =~ s/\(/\[/g;
> + $after =~ s/\)/\]/g;
> + $query_to_mongo .= $before . "{\'\$nin\'=>" . $after . "}},";
> + }
> + }
> + elsif($arg =~ m/{.+=>.+}/)
> + {
> + $query_to_mongo .= $arg . ",";
> + }
> + elsif($arg =~ m/>|=|<|IN/)
> + {
> + #print "before match1: ", $before," after match: ",$after," match case: ",$match_case,"\n";
> +
> + $before ="{\'$prefix" . $` . "\'=>";
> + $after = $';
> + $match_case = $&;
> +
> + if($match_case eq ">")
> + {
> + #print "bolshe\n";
> + $query_to_mongo .= $before . "{\'\$gt\'=>" . $after . "}},";
> +
> + }elsif($match_case eq "=")
> + {
> + #print "ravno\n";
> + $query_to_mongo .= $before . $after ."},";
> + }elsif($match_case eq "<")
> + {
> + #print "menshe\n";
> + $query_to_mongo .= $before . "{\'\$lt\'=>" . $after . "}},";
> + }
> + else
> + {
> + #print "IN\n";
> + $after =~ s/\(/\[/g;
> + $after =~ s/\)/\]/g;
> + $query_to_mongo .= $before . "{\'\$in\'=>" . $after . "}},";
> + }
> + }
> + }
> + chop($query_to_mongo);
> + $query_to_mongo .= "]} ";
> + return $query_to_mongo;
> +}
> +
> +###############################################################################
> +#
> +# Show help to tool
> +#
> +###############################################################################
> +sub help
> +{
> + my ($action)=@_;
> +
> + print ("Usage: $module_name [options...] <action> [arguments...]\n");
> + print ("\'$module_name\' communicate with datastore .\n\n");
> +
> + print ("\nOptions:\n");
> + printf (" %-5s %-10s\t%-s\n", '-h,', '--help', "Show the help message and exit.");
> + printf (" %-5s %-10s\t%-s\n", '-a,', '--server', "The server to connect to.");
> + printf (" %-5s %-10s\t%-s\n", '-u,', '--username', "User name.");
> + printf (" %-5s %-10s\t%-s\n", '-p,', '--password', "Password.");
> +
> + print ("\nActions:\n");
> +
> + if (!defined($action) || $action eq '' || $action eq 'ping')
> + {
> + print (" --ping\t The 'ping' command check connection with datastore.\n");
> + }
> + if (!defined($action) || $action eq '' || $action eq 'upload')
> + {
> + print (" --upload\t The 'upload' command translates input data into datastore entities and uploads them into your application's datastore.\n");
> + }
> + if (!defined($action) || $action eq '' || $action eq 'query')
> + {
> + print (" --query\t The 'query' command translates input string in special request to datastore and download data form query set.\n");
> + }
> + if (!defined($action) || $action eq '' || $action eq 'view')
> + {
> + print (" --view\t The 'view' command requests information from datastore.\n");
> + }
> + if (!defined($action) || $action eq '' || $action eq 'admin')
> + {
> + print (" --admin\t The 'admin' admin of datastore operations.\n");
> + }
> +
> + print ("\nArguments:\n");
> +
> + if (!defined($action) || $action eq '' || $action eq 'upload')
> + {
> + printf (" %-5s %-10s\t%-s\n", '-S,', '--data', "The name of the file containing the data to upload.");
> + printf (" %-5s %-10s\t%-s\n", '-R,', '--raw', "Raw file associated with data.");
> + }
> + if (!defined($action) || $action eq '' || $action eq 'query')
> + {
> + printf (" %-5s %-10s\t%-s\n", '-L,', '--gqls', "String with GQL query.");
> + printf (" %-5s %-10s\t%-s\n", '-F,', '--gqlf', "The path to file inclusive query.");
> + printf (" %-5s %-10s\t%-s\n", '-T,', '--section', "Section of configuration file with query.");
> + printf (" %-5s %-10s\t%-s\n", '-O,', '--dir', "The path to the directory that will store retrieved data.");
> + printf (" %-5s %-10s\t%-s\n", '', '--no-raw', "Don't download Raw file associated with data.");
> + }
> + if (!defined($action) || $action eq '' || $action eq 'view')
> + {
> + printf (" %-5s %-10s\t%-s\n", '-D,', '--dstore', "Retrieve Google Data store detailed organization with names of models and properties.");
> + printf (" %-5s %-10s\t%-s\n", '-I,', '--info', "Show information about clusters, compilers, bench applications and mpi. One of following as 'suite','mpi','compiler','cluster'");
> + printf (" %-5s %-10s\t%-s\n", '-L,', '--gqls', "String with GQL query.");
> + printf (" %-5s %-10s\t%-s\n", '-F,', '--gqlf', "The path to file inclusive query.");
> + printf (" %-5s %-10s\t%-s\n", '-T,', '--section', "Section of configuration file with query.");
> + printf (" %-5s %-10s\t%-s\n", '-V,', '--format', "Output format. One of following as 'txt','html','yaml','raw'. Default is 'raw'");
> + }
> + if (!defined($action) || $action eq '' || $action eq 'admin')
> + {
> + printf (" %-5s %-10s\t%-s\n", '', '--newuser', "User information as username, password, email (mandatory) and first_name, last_name (optinal). Keep order");
> + }
> + printf (" %-5s %-10s\t%-s\n", '-e,', '--email', "e-mail address");
> +
> + exit;
> +}
> +
> +
> +###############################################################################
> +#
> +# Check if files directed in command line exists
> +#
> +###############################################################################
> +sub verify_opt_file
> +{
> + my (@files)=@_;
> + foreach my $file (@files)
> + {
> + if( ! -e $file)
> + {
> + die "$file doesn't exist!";
> + }
> + }
> +}
> +
> +
> +###############################################################################
> +#
> +# Ping procedure
> +#
> +###############################################################################
> +sub ping
> +{
> + my ($conf_ref)=@_;
> +
> + my $ua = LWP::UserAgent->new();
> + $ua->agent("mtt-submit");
> + $ua->proxy('http', $ENV{'http_proxy'});
> +
> + my $request = POST(
> + $conf_ref->{url},
> + Content_Type => 'form-data',
> + Content => [
> + PING => 1,
> + description => 'bquery ping'
> + ]);
> +
> + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
> +
> + my $response = $ua->request($request);
> +
> + print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
> + unless $response->is_success;
> + print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
> + unless $response->content_type eq 'text/html';
> +
> + print $response->content;
> +}
> +
> +
> +###############################################################################
> +#
> +# Upload procedure
> +#
> +###############################################################################
> +sub upload
> +{
> + my ($conf_ref)=@_;
> + my $i = 0;
> + use MongoDB;
> + use MongoDB::OID;
> + use YAML;
> + use Data::Dumper;
> + use YAML::XS;
> + my $conn = MongoDB::Connection->new(host => 'bgate.mellanox.com:27017');
> + my $db = $conn->mtt;
> + my $TestRunPhase = $db->TestRunPhase;
> + for ($i=0; $i<@{$conf_ref->{data}}; $i++)
> + {
> + my $ua = LWP::UserAgent->new();
> + $ua->agent("mtt-submit");
> + $ua->proxy('http', $ENV{'http_proxy'});
> +
> + my $request;
> + my $data_file = "$conf_ref->{data}->[$i]" if defined($conf_ref->{data}->[$i]);
> + my $raw_file = "$conf_ref->{raw}->[$i]" if defined($conf_ref->{raw}->[$i]);
> + if ($raw_file)
> + {
> + #$request = POST(
> + # $conf_ref->{url},
> + # Content_Type => 'form-data',
> + # Content => [
> + # SUBMIT => 1,
> + # data => [$data_file],
> + # raw => [$raw_file],
> + # description => 'MTT Results Submission'
> + # ]);
> + }
> + else
> + {
> + print "load $data_file\n";
> + open my $fh, '<', "$data_file"
> + or die "can't open config file: $!";
> + my $f_hash = LoadFile($fh);
> + #print Dumper($f_hash), "\n";
> + my $inserted_id = $TestRunPhase->insert($f_hash);
> + print "inserted id $inserted_id \n";
> + #$request = POST(
> + # $conf_ref->{url},
> + # Content_Type => 'form-data',
> + # Content => [
> + # SUBMIT => 1,
> + # data => [$data_file],
> + # description => 'bquery submit'
> + # ]);
> + }
> +
> + #$request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
> +
> + #my $response = $ua->request($request);
> +
> + #print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
> + # unless $response->is_success;
> + #print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
> + # unless $response->content_type eq 'text/html';
> +
> + #print $response->content;
> + }
> +}
> +
> +
> +###############################################################################
> +#
> +# Query procedure
> +#
> +###############################################################################
> +sub query
> +{
> + my ($conf_ref)=@_;
> +
> + my $ua = LWP::UserAgent->new();
> + $ua->agent("mtt-submit");
> + $ua->proxy('http', $ENV{'http_proxy'});
> +
> + my $request = POST(
> + $conf_ref->{url},
> + Content_Type => 'form-data',
> + Content => [
> + QUERY => 1,
> + gql => $conf_ref->{gql},
> + raw => $conf_ref->{raw},
> + description => 'bquery view'
> + ]);
> +
> + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
> +
> + my $response = $ua->request($request);
> +
> + die "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
> + unless $response->is_success;
> + die "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
> + unless $response->content_type eq 'text/yaml';
> +
> + # Load respond into YAML hash
> + use YAML::Syck ();
> + $YAML::Syck::ImplicitTyping = 1;
> + my $temp_str = $response->content;
> + my $data = eval {YAML::Syck::Load($temp_str)};
> +# use YAML::XS ();
> +# my $temp_str = $response->content;
> +# my $data = eval {YAML::XS::Load($temp_str)};
> + if (not defined $data or $@)
> + {
> + die "$!";
> + }
> +
> + MTT::Files::mkdir($conf_ref->{dir}) || die "cannot mkdir $conf_ref->{dir}: $!";
> +
> + my $default_form = {
> + product => 'mtt-gds',
> + version => "0.1",
> + app_id => 'query'
> + };
> +
> + foreach my $respond_form (@{$data->{data}})
> + {
> + my $filename = "$conf_ref->{dir}\/$respond_form->{key}";
> + my $raw_filename = $filename.'.zip';
> + $filename = $filename.'.yaml';
> +
> + my %form = (%$respond_form, %$default_form);
> +
> + if (int($conf_ref->{raw}) == 1 && exists($form{raw}))
> + {
> + open(fh_temp, ">$raw_filename") || die "cannot create $raw_filename: $!";
> + binmode fh_temp;
> + print fh_temp $form{raw};
> + close fh_temp;
> +
> + delete $form{raw};
> + }
> +
> + delete $form{key};
> +
> + # Generate YAML file contents
> + YAML::XS::DumpFile($filename, \%form);
> + }
> +}
> +
> +
> +###############################################################################
> +#
> +# View procedure
> +#
> +###############################################################################
> +sub view
> +{
> + my ($conf_ref)=@_;
> +
> + my $ua = LWP::UserAgent->new();
> + $ua->agent("mtt-submit");
> + $ua->proxy('http', $ENV{'http_proxy'});
> +
> + my $request;
> + if (exists($conf_ref->{kind}))
> + {
> + $request = POST(
> + $conf_ref->{url},
> + Content_Type => 'form-data',
> + Content => [
> + VIEW => 1,
> + kind => $conf_ref->{kind},
> + format => $conf_ref->{format},
> + description => 'bquery view'
> + ]);
> + }
> + elsif (exists($conf_ref->{gql}))
> + {
> + $request = POST(
> + $conf_ref->{url},
> + Content_Type => 'form-data',
> + Content => [
> + VIEW => 1,
> + gql => $conf_ref->{gql},
> + format => $conf_ref->{format},
> + description => 'bquery view'
> + ]);
> + }
> +
> + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
> +
> + my $response = $ua->request($request);
> +
> + print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
> + unless $response->is_success;
> + print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
> + unless $response->content_type eq 'text/html';
> +
> + print $response->content;
> +}
> +
> +
> +###############################################################################
> +#
> +# Admin procedure
> +#
> +###############################################################################
> +sub admin
> +{
> + my ($conf_ref)=@_;
> +
> + my $ua = LWP::UserAgent->new();
> + $ua->agent("mtt-submit");
> + $ua->proxy('http', $ENV{'http_proxy'});
> +
> + my $request;
> + if (exists($conf_ref->{newuser}) && $#{$conf_ref->{newuser}} >=2)
> + {
> + $request = POST(
> + $conf_ref->{url},
> + Content_Type => 'form-data',
> + Content => [
> + ADMIN => 1,
> + _NEWUSER_ => 1,
> + username => $conf_ref->{newuser}->[0],
> + password => $conf_ref->{newuser}->[1],
> + email => $conf_ref->{newuser}->[2],
> + first_name => ($#{$conf_ref->{newuser}} >=3 ? $conf_ref->{newuser}->[3] : ''),
> + last_name => ($#{$conf_ref->{newuser}} >=4 ? $conf_ref->{newuser}->[4] : ''),
> + description => 'bquery admin'
> + ]);
> + }
> +
> + $request->authorization_basic($conf_ref->{username}, $conf_ref->{password});
> +
> + my $response = $ua->request($request);
> +
> + print "Error at $conf_ref->{url}\n ", $response->status_line, "\n"
> + unless $response->is_success;
> + print "content type at $conf_ref->{url} -- ", $response->content_type, "\n"
> + unless $response->content_type eq 'text/html';
> +
> + print $response->content;
> +}
> +
> +
> +###############################################################################
> +#
> +# Send files by e-mail
> +#
> +###############################################################################
> +sub send_results_by_mail
> +{
> + my ($mail_to, @files) = @_;
> +
> + foreach my $mail_file (@files)
> + {
> + system("echo report is attached | /usr/bin/mutt -s 'breport' -a $mail_file $mail_to");
> + }
> +}
>
> Added: trunk/lib/MTT/Reporter/MTTMongodb.pm
> ==============================================================================
> --- /dev/null 00:00:00 1970 (empty, because file is newly added)
> +++ trunk/lib/MTT/Reporter/MTTMongodb.pm 2012-08-01 05:46:03 EDT (Wed, 01 Aug 2012) (r1481)
> @@ -0,0 +1,1195 @@
> +#!/usr/bin/env perl
> +#
> +# Copyright (c) 2009 Voltaire
> +# Copyright (c) 2010 Cisco Systems, Inc. All rights reserved.
> +# $COPYRIGHT$
> +#
> +# Additional copyrights may follow
> +#
> +# $HEADER$
> +#
> +
> +package MTT::Reporter::MTTMongodb;
> +
> +use strict;
> +use MTT::Messages;
> +use MTT::Values;
> +use MTT::Values::Functions;
> +use MTT::Version;
> +use MTT::Globals;
> +use MTT::DoCommand;
> +use LWP::UserAgent;
> +use HTTP::Request::Common qw(POST);
> +use Data::Dumper;
> +use File::Basename;
> +use File::Temp qw(tempfile tempdir);
> +use YAML::XS;
> +
> +use POSIX qw(strftime);
> +use File::stat;
> +
> +# http credentials
> +my $username;
> +my $password;
> +my $realm;
> +my $url;
> +my $port;
> +
> +# platform common name
> +my $platform;
> +
> +# LWP user agents (one per proxy)
> +my @lwps;
> +
> +# Hostname string to report
> +my $hostname;
> +
> +# User ID (can be overridden in the INI)
> +my $local_username;
> +
> +# directory and file to write to
> +my $dirname;
> +
> +my $testrun_files_count = 0;
> +my $testbuild_files_count = 0;
> +my $mpiinstall_files_count = 0;
> +
> +our $clusterInfo = undef;
> +
> +#--------------------------------------------------------------------------
> +
> +sub Init {
> + my ($ini, $section) = @_;
> +
> + Debug("[MTTGDS reporter] Init\n");
> +
> + # Have we been initialized already? If so, error -- per #261,
> + # this module can currently only handle submitting to one database
> + # in a given run.
> +
> + if (defined($username)) {
> + Error("The MTTGDS plugin can only be used once in an INI file.\n");
> + }
> +
> + # Extract data from the ini fields
> +
> + $username = Value($ini, $section, "mttdatabase_username");
> + $password = Value($ini, $section, "mttdatabase_password");
> + $url = Value($ini, $section, "mttdatabase_url");
> + #$url = Value($ini, $section, "mttdatabase_url").'client';
> + $realm = Value($ini, $section, "mttdatabase_realm");
> + $hostname = Value($ini, $section, "mttdatabase_hostname");
> + $local_username = Value($ini, "mtt", "local_username");
> +
> + if (!$url) {
> + Warning("Need URL in MTTGDS Reporter section [$section]\n");
> + return undef;
> + }
> + my $count = 0;
> + ++$count if ($username);
> + ++$count if ($password);
> + ++$count if ($realm);
> + if ($count > 0 && $count != 3) {
> + Warning("MTTGDS Reporter section [$section]: if password, username, or realm is specified, they all must be specified.\n");
> + return undef;
> + }
> + $platform = Value($ini, $section, "mttdatabase_platform");
> +
> + # Extract the host and port from the URL. Needed for the
> + # credentials section.
> +
> + my $dir;
> + my $host = $url;
> + if ($host =~ /(http:\/\/[-a-zA-Z0-9.]+):(\d+)\/?(.*)?$/) {
> + $host = $1;
> + $port = $2;
> + $dir = $3;
> + } elsif ($host =~ /(http:\/\/[-a-zA-Z0-9.]+)\/?(.*)?$/) {
> + $host = $1;
> + $dir = $2;
> + $port = 80;
> + } elsif ($host =~ /(https:\/\/[-a-zA-Z0-9.]+)\/?(.*)?$/) {
> + $host = $1;
> + $dir = $2;
> + $port = 443;
> + } elsif ($host =~ /(https:\/\/[-a-zA-Z0-9.]+):(\d+)\/?(.*)?$/) {
> + $host = $1;
> + $port = $2;
> + $dir = $3;
> + } else {
> + Warning("MTTGDS Reporter did not get a valid url: $url .\n");
> + return undef;
> + }
> + $url = "$host:$port";
> + # Setup proxies
> + my $scheme = (80 == $port) ? "http" : "https";
> +
> + # Create the Perl LWP stuff to setup for HTTP requests later.
> + # Make one for each proxy (we'll always have at least one proxy
> + # entry, even if it's empty).
> + my $proxies = \@{$MTT::Globals::Values->{proxies}->{$scheme}};
> + foreach my $p (@{$proxies}) {
> + my %params = { env_proxy => 0 };
> + my $ua = LWP::UserAgent->new(%params);
> +
> + # @#$@!$# LWP proxying for https *does not work*. So
> + # don't set $ua->proxy() for it. Instead, we'll set
> + # $ENV{https_proxy} whenever we process requests that
> + # require SSL proxying, because that is obeyed deep down
> + # in the innards underneath LWP.
> + $ua->proxy([$scheme], $p->{proxy})
> + if ($p->{proxy} ne "" && $scheme ne "https");
> + $ua->agent("MPI Test MTTGDS Reporter");
> + push(@lwps, {
> + scheme => $scheme,
> + agent => $ua,
> + proxy => $p->{proxy},
> + source => $p->{source},
> + });
> + }
> + if ($realm && $username && $password) {
> + Verbose(" Set HTTP credentials for realm \"$realm\"\n");
> + }
> +
> + # Do a test ping to ensure that we can reach this URL.
> +
> + Debug("MTTGDS client pinging a server...\n");
> + my $form = {
> + PING => 1,
> + Description => 'Pinging a server'
> + };
> + #DINARDINARDINARDINAR
> + #my $req = POST ($url, $form);
> + #$req->authorization_basic($username, $password);
> + #my $response = _do_request($req);
> + #if (! $response->is_success()) {
> + # Warning(">> Failed test ping to MTTGDS URL: $url\n");
> + # Warning(">> Error was: " . $response->status_line . "\n" .
> + # $response->content);
> + # Error(">> Do not want to continue with possible bad submission URL -- aborting\n");
> + #}
> + #DINARDINARDINARDINAR
> + #Debug("MTTGDS reporter initialized ($realm, $username, XXXXXX, $url, $platform)\n");
> + #Debug("MTTGDS reporter respond content ($response->content)\n");
> +
> + # Extract data from the ini fields
> +
> + $dirname = MTT::DoCommand::cwd();
> +
> + Debug("Collect cluster information...\n");
> + my $clusterinfo_module = MTT::Values::Value($ini, "vbench", "clusterinfo_module");
> + $clusterinfo_module = "UnknownCluster" if (!defined($clusterinfo_module) || $clusterinfo_module eq "");
> + Debug("Use $clusterinfo_module module to collect information.\n");
> +
> + $clusterInfo = MTT::Module::Run("MTT::Reporter::Utils::$clusterinfo_module", "get_cluster_info", MTT::Values::Functions::env_hosts(2));
> + if (!defined($clusterInfo)) {
> + Error("Fatal: Can't collect cluster information\n");
> + }
> + Debug("Collect cluster information Finished\n");
> +
> + Debug("File reporter initialized ($dirname)\n");
> +
> + return 1;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +my $entries;
> +
> +sub Submit {
> +
> +
> + my ( $info, $newentries ) = @_;
> +
> + Debug("[MTTGDS reporter] Submit\n");
> +
> + if (!defined($newentries)) {
> + Warning("[MTTGDS reporter]: Submit parameter is undef. Skip.\n");
> + return;
> + }
> +
> + if ( !defined($entries) ) {
> + %$entries = ();
> + }
> +
> + foreach my $phase (keys(%$newentries))
> + {
> + my $phase_obj = $newentries ->{$phase};
> +
> + foreach my $section ( keys(%$phase_obj) )
> + {
> + Debug("Phase: $phase Section: $section\n");
> +
> + my $new_section_obj = $phase_obj->{$section};
> +
> + my $section_obj = $entries->{$phase}->{$section};
> +
> + foreach my $report (@$new_section_obj)
> + {
> + Debug(" add report\n");
> + push(@$section_obj, $report);
> + }
> +
> + $entries->{$phase}->{$section} = $section_obj;
> +
> + }
> + }
> +
> + Verbose(">> Reporter MTTGDS: cached for later submit\n");
> + Debug("[MTTGDS reporter] Exit from Submit\n");
> +}
> +
> +sub Finalize {
> + Debug("[MTTGDS reporter] Finalize\n");
> +
> + _do_submit();
> + undef $entries;
> +
> + undef $username;
> + undef $password;
> + undef $realm;
> + undef $url;
> + undef $platform;
> + undef @lwps;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _do_submit {
> + #DinarDinarDinarDinar
> + use MongoDB;
> + use MongoDB::OID;
> + use YAML;
> + use Data::Dumper;
> + use YAML::XS;
> + $url =~ s/http:\/\///;
> + my $conn = MongoDB::Connection->new(host => $url);
> + my $db = $conn->mtt;
> + my $TestRunPhase = $db->TestRunPhase;
> + my $MPIInstallPhase = $db->MPIInstallPhase;
> + my $TestBuildPhase = $db->TestBuildPhase;
> + my $doc;
> + my @numbers;
> + my $inserted_id;
> + my $old_date;
> + my %new_date;
> + #DinarDinarDinarDinar
> +
> + # Make a default form that will be used to seed all the forms that
> + # will be sent
> + my $default_form = {
> + product => 'mtt-gds',
> + version => "0.1",
> + app_id => 'submit',
> + };
> +
> + my $ini = $MTT::Globals::Internals->{ini};
> + my $submit_failed_results = MTT::Values::Value( $ini, "VBench", 'submit_failed_results_to_gds' );
> +
> + # mtt ini flag to control what mtt results to submit to GDS
> + if (!defined($submit_failed_results) || $submit_failed_results eq '')
> + {
> + $submit_failed_results = 1;
> + }
> +
> + my $submit_results = MTT::Values::Value( $ini, "VBench", 'submit_results_to_gds' );
> + # mtt ini flag to control what mtt results to submit to GDS
> + if (!defined($submit_results) || $submit_results eq '' || $submit_results eq '1' || $submit_results eq 'True')
> + {
> + $submit_results = 1;
> + } else {
> + $submit_results = 0;
> + }
> +
> + #foreach my $phase (keys(%$entries)) {
> + foreach my $phase ( "MPI Install", "Test Build", "Test Run" )
> + {
> + my $submitted = 0;
> + my $phase_obj = $entries->{$phase};
> +
> + foreach my $section ( keys(%$phase_obj) )
> + {
> + my $section_obj = $phase_obj->{$section};
> +
> + foreach my $report_original (@$section_obj)
> + {
> +
> + # Each section of a phase gets its own report to the
> + # database. Make a deep copy of the default form to start
> + # with.
> + my $form;
> + %$form = %{$default_form};
> + $form->{modules} = {};
> +
> + # Ensure to do a deep copy of the report (vs. just
> + # copying the reference) because we want to locally
> + # change some values
> + my $report;
> + %$report = %{$report_original};
> + %$report->{files_to_copy} = {} if (!exists($report->{files_to_copy}));
> +
> + $MTT::Values::Functions::current_report = $report;
> +
> + my $attachment = {};
> +
> + if ( $phase eq "Test Run" )
> + {
> +
> + my $mpi_install = $entries->{"MPI Install"}->{$report->{mpi_install_section_name}};
> + my $mpi_report = @$mpi_install[0];
> +
> + _process_phase_mpi_install("MPI Install", $report->{mpi_install_section_name}, $mpi_report, $form->{modules});
> +
> + my $test_build = $entries->{"Test Build"}->{$report->{test_build_section_name}};
> + my $build_report = @$test_build[0];
> + _process_phase_test_build("Test Build", $report->{test_build_section_name}, $build_report, $form->{modules});
> +
> + _process_phase_test_run($phase, $section, $report, $form->{modules});
> + $attachment = $report->{files_to_copy};
> + }
> + elsif ( $phase eq "Test Build" )
> + {
> + my $mpi_install = $entries->{"MPI Install"}->{$report->{mpi_install_section_name}};
> + my $mpi_report = @$mpi_install[0];
> + _process_phase_mpi_install("MPI Install", $report->{mpi_install_section_name}, $mpi_report, $form->{modules});
> +
> + _process_phase_test_build($phase, $section, $report, $form->{modules});
> + }
> + elsif ( $phase eq "MPI Install" )
> + {
> + _process_phase_mpi_install($phase, $section, $report, $form->{modules});
> + }
> + else
> + {
> + Debug("Phase: $phase Section: $section SKIPPED\n");
> + next;
> + }
> +
> + $MTT::Values::Functions::current_report = undef;
> +
> + Debug("Submitting to MongoDB...\n");
> +
> + my ($req, $file) = _prepare_request($phase, $report, $form, $attachment);
> +
> + # do not submit result with non PASS status in case 'submit_failed_results_to_gds' key is set as '0'
> + if ( ($submit_failed_results == 0) && ($report->{test_result} != 1) )
> + {
> + Debug("MTT ini-file has key \'submit_failed_results_to_gds\'=$submit_failed_results and phase: $phase test_result: $report->{test_result}\n");
> + next;
> + }
> +
> + if ( $submit_results == 0 )
> + {
> + Debug("MTT ini-file has key \'submit_results_to_gds\'=$submit_results\n");
> + next;
> + }
> +
> + #DinarDinarDinar
> + if ( $phase eq "Test Run" )
> + {
> +
> + #$old_date = $form->{'modules'}->{'TestRunPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'TestRun_start_time'} = DateTime->new(%new_date);
> +
> +
> + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'TestBuild_start_time'} = DateTime->new(%new_date);
> +
> +
> + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'MpiInstall_start_time'} = DateTime->new(%new_date);
> +
> +
> + #$old_date = $form->{'modules'}->{'TestRunPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> +
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'TestRun_end_time'} = DateTime->new(%new_date);
> +
> +
> + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'TestBuild_end_time'} = DateTime->new(%new_date);
> +
> +
> + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'MpiInstall_end_time'} = DateTime->new(%new_date);
> +
> +
> + my $inserted_id = $TestRunPhase->insert($form);
> +
> +
> +
> + #$doc = ($TestRunPhase->find({'_id'=>$inserted_id}))->next;
> +
> + #TestRun
> + #$old_date = $doc->{'modules'}->{'TestRunPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestRunPhase.start_time'=>DateTime->new(%new_date)}});
> +
> + #$old_date = $doc->{'modules'}->{'TestRunPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestRunPhase.end_time'=>DateTime->new(%new_date)}});
> +
> + #MPIInstall
> + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.start_time'=>DateTime->new(%new_date)}});
> +
> + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.end_time'=>DateTime->new(%new_date)}});
> +
> +
> + #TestBuild
> + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.start_time'=>DateTime->new(%new_date)}});
> +
> + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestRunPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.end_time'=>DateTime->new(%new_date)}});
> +
> +
> +
> + }
> + if ( $phase eq "MPI Install" )
> + {
> +
> + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'MpiInstall_start_time'} = DateTime->new(%new_date);
> +
> +
> + #$old_date = $form->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'MpiInstall_end_time'} = DateTime->new(%new_date);
> +
> + $inserted_id = $MPIInstallPhase->insert($form);
> +
> +
> +
> +
> + #$doc = ($MPIInstallPhase->find({'_id'=>$inserted_id}))->next;
> +
> + #MPIInstall
> + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$MPIInstallPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.start_time'=>DateTime->new(%new_date)}});
> +
> + #$old_date = $doc->{'modules'}->{'MpiInstallPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$MPIInstallPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.MpiInstallPhase.end_time'=>DateTime->new(%new_date)}});
> +
> + }
> + if ( $phase eq "Test Build")
> + {
> +
> +
> +
> + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$form->{'TestBuild_start_time'} = DateTime->new(%new_date);
> +
> +
> + #$old_date = $form->{'modules'}->{'TestBuildPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> +
> + #$form->{'TestBuild_end_time'} = DateTime->new(%new_date);
> +
> + my $inserted_id = $TestBuildPhase->insert($form);
> +
> +
> +
> + #$doc = ($TestBuildPhase->find({'_id'=>$inserted_id}))->next;
> +
> + #TestBuild
> + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'start_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestBuildPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.start_time'=>DateTime->new(%new_date)}});
> +
> + #$old_date = $doc->{'modules'}->{'TestBuildPhase'}->{'end_time'};
> + #@numbers = split(/:|-|\s/,$old_date);
> + #print @numbers[0],"-year " , @numbers[1], "-month ", @numbers[2], "-day ", @numbers[3],"-hour " , @numbers[4] ,"-min ", @numbers[5],"-sec\n";
> + #%new_date = (year => @numbers[0],month => @numbers[1],day => @numbers[2],hour => @numbers[3],minute => @numbers[4],second => @numbers[5],nanosecond => 0,time_zone=> 'America/Chicago');
> + #$TestBuildPhase->update({'_id'=>$inserted_id},{'$set'=>{'modules.TestBuildPhase.end_time'=>DateTime->new(%new_date)}});
> + }
> + #DinarDinarDinar
> +
> + $submitted = 1;
> + }
> + }
> + Verbose(">> Submitted $phase to MongoDB\n")
> + if ($submitted);
> + }
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _process_phase_mpi_install {
> + my ( $phase, $section, $report, $form )=@_;
> + $form->{MpiInstallPhase} = {};
> + my $phase_form = $form->{MpiInstallPhase};
> +
> + _fill_submit_info( $phase, $section, $report, $form );
> + _fill_compiler_info( $phase, $section, $report, $form );
> + _fill_cluster_info( $phase, $section, $report, $form );
> + _fill_mpi_info( $phase, $section, $report, $form );
> +
> + $phase_form->{start_time} = strftime( "%Y-%m-%d %H:%M:%S",
> + localtime $report->{start_timestamp} );
> +
> + my $duration = $report->{duration};
> + $duration =~ m/^(\w+)\s(.+)/;
> + $duration = $1;
> + $phase_form->{duration} = $duration;
> +
> + $phase_form->{end_time} = strftime( "%Y-%m-%d %H:%M:%S",
> + localtime ($report->{start_timestamp} + $phase_form->{duration}) );
> +
> + $phase_form->{description} = $report->{description};
> + $phase_form->{stdout} = $report->{result_stdout};
> + $phase_form->{stderr} = $report->{result_stderr};
> + $phase_form->{status} = $report->{test_result};
> + $phase_form->{configuration} = $report->{configure_arguments};
> +
> + my $ini = $MTT::Globals::Internals->{ini};
> + my $mpi_section = $report->{mpi_install_section_name};
> +
> + my $mpiget_section = MTT::Values::Value( $ini, "MPI install: " . $mpi_section, "mpi_get" );
> +
> + my $mpiget_module = MTT::Values::Value( $ini, "MPI get: " . $mpiget_section, "module" );
> +
> + if ($mpiget_module eq "AlreadyInstalled") {
> + $phase_form->{mpi_path} = MTT::Values::Value( $ini, "MPI get: ". $mpiget_section, "alreadyinstalled_dir" );
> + $phase_form->{mpi_path} = EvaluateString( $phase_form->{mpi_path}, $ini, "MPI get: ". $mpiget_section );
> + } else {
> + my $mpi_install = $MTT::MPI::installs->{$mpiget_section}->{$report->{mpi_version}}->{$mpi_section};
> + $phase_form->{mpi_path} = $mpi_install->{installdir};
> + }
> +
> + return 0;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _process_phase_test_build {
> + my ( $phase, $section, $report, $form )=@_;
> + $form->{TestBuildPhase} = {};
> + my $phase_form = $form->{TestBuildPhase};
> +
> + _fill_submit_info( $phase, $section, $report, $form );
> + _fill_compiler_info( $phase, $section, $report, $form );
> + _fill_cluster_info( $phase, $section, $report, $form );
> + _fill_mpi_info( $phase, $section, $report, $form );
> + _fill_suite_info( $phase, $section, $report, $form );
> +
> + $phase_form->{start_time} = strftime( "%Y-%m-%d %H:%M:%S",
> + localtime $report->{start_timestamp} );
> +
> + my $duration = $report->{duration};
> + $duration =~ m/^(\w+)\s(.+)/;
> + $duration = $1;
> + $phase_form->{duration} = $duration;
> +
> + $phase_form->{end_time} = strftime( "%Y-%m-%d %H:%M:%S",
> + localtime ($report->{start_timestamp} + $phase_form->{duration}) );
> +
> + $phase_form->{description} = $report->{description};
> + $phase_form->{stdout} = $report->{result_stdout};
> + $phase_form->{stderr} = $report->{result_stderr};
> + $phase_form->{status} = $report->{test_result};
> +
> + return 0;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _process_phase_test_run {
> + my ( $phase, $section, $report, $form )=@_;
> + $form->{TestRunPhase} = {};
> +
> + _pre_process_phase( $phase, $section, $report, $form );
> +
> + # copy benchmark's additional data about mpi (filled in benchmark's analyzer)
> + %$form->{TestRunPhase} = ( %$report->{testphase} ) if (defined ($report->{testphase}));#!!!!!!!!!!!!
> + my $phase_form = $form->{TestRunPhase};
> +
> + _fill_submit_info( $phase, $section, $report, $form );
> + _fill_compiler_info( $phase, $section, $report, $form );
> + _fill_cluster_info( $phase, $section, $report, $form );
> + _fill_mpi_info( $phase, $section, $report, $form );
> + _fill_suite_info( $phase, $section, $report, $form );
> +
> + $phase_form->{start_time} = strftime( "%Y-%m-%d %H:%M:%S",
> + localtime $report->{start_timestamp} );
> +
> + my $duration = $report->{duration};
> + $duration =~ m/^(\w+)\s(.+)/;
> + $duration = $1;
> + $phase_form->{duration} = $duration;
> +
> + $phase_form->{end_time} = strftime( "%Y-%m-%d %H:%M:%S",
> + localtime ($report->{start_timestamp} + $phase_form->{duration}) );
> +
> + $phase_form->{description} = $report->{description};
> + $phase_form->{stdout} = $report->{result_stdout};
> + $phase_form->{stderr} = $report->{result_stderr};
> + $phase_form->{status} = $report->{test_result};
> + $phase_form->{cmdline} = $report->{command};
> + my @sections;
> + push( @sections, "test run: " . $section );
> + push( @sections, "MTT" );
> + push( @sections, "VBench" );
> +
> + $phase_form->{test_name} = $report->{test_name} if (!defined($phase_form->{test_name}));
> +
> + $phase_form->{mpi_nproc} = int($report->{np});
> + $phase_form->{mpi_hlist} = MTT::Values::Functions::env_hosts(2);
> +
> + $phase_form->{net_note} = _get_value( "vbench:net_note", @sections );
> +
> + my $ini = $MTT::Globals::Internals->{ini};
> + my @taglist = ();
> + my @tagsections = (@sections);
> + foreach my $tagsection (@tagsections) {
> + my @val = MTT::Values::Value($ini, $tagsection, "vbench:tag");
> + if ( $#val != (-1) ) {
> + @val = split(/\n/, $val[0]) if ($#val == 0);
> + foreach (@val)
> + {
> + my $tag = $_;
> + push( @taglist, $tag ) if ($tag);
> + }
> + }
> + }
> + @{$phase_form->{tag}} = @taglist;
> +
> + $phase_form->{test_case} = $report->{parameters}
> + if ( !defined( $phase_form->{test_case} ) );
> +
> + # JMS Why do we have an mpi_mca field? Shouldn't this kind of
> + # stuff be in the MPI Details parameters and network fields?
> + if (!defined($phase_form->{mpi_mca})) {
> + # JMS Should generlize this to be "extract from the current
> + # ::MPI::module". There are other instances of this direct
> + # call in MTT::Test::Analyze::Performance::*.
> + $phase_form->{mpi_mca} =
> + MTT::Values::Functions::MPI::OMPI::find_mca_params($report->{command});
> +
> + if (!defined($phase_form->{mpi_rlist})) {
> + my $rankfile = undef;
> + my $cmdline = $report->{command};
> + if ( $cmdline =~ m/-rf\s([\S]+)/ ) {
> + $rankfile = $1;
> + }
> + if ( $cmdline =~ m/--rankfile\s([\S]+)/ ) {
> + $rankfile = $1;
> + }
> + $phase_form->{mpi_rlist} = $rankfile;
> + }
> + } else {
> + if (!defined($phase_form->{mpi_rlist})) {
> + $phase_form->{mpi_rlist} = "";
> + }
> + }
> +
> + if ( $phase_form->{mpi_rlist} ne "") {
> + push(@{$report->{files_to_copy}}, $phase_form->{mpi_rlist});
> + }
> +
> + # fill mpi_btl string list
> + if ($phase_form->{mpi_mca} =~ m/-mca\sbtl\s(\S+)/) {
> + @{$phase_form->{mpi_btl}} = split /,/, $1;
> + } else {
> + @{$phase_form->{mpi_btl}} = ();
> + }
> +
> + # filling dynamic fields with prefix "data_"
> + $phase_form->{data_message_size} = $report->{message_size} if (exists( $report->{message_size} ));
> + $phase_form->{data_latency_min} = $report->{latency_min} if (exists( $report->{latency_min} ));
> + $phase_form->{data_latency_avg} = $report->{latency_avg} if (exists( $report->{latency_avg} ));
> + $phase_form->{data_latency_max} = $report->{latency_max} if (exists( $report->{latency_max} ));
> + $phase_form->{data_bandwidth_min} = $report->{bandwidth_min} if (exists( $report->{bandwidth_min} ));
> + $phase_form->{data_bandwidth_avg} = $report->{bandwidth_avg} if (exists( $report->{bandwidth_avg} ));
> + $phase_form->{data_bandwidth_min} = $report->{bandwidth_min} if (exists( $report->{bandwidth_min} ));
> +
> + # filling dynamic fields with prefix "custom_"
> +
> + # Special named export environment variables set in mpirun command line
> + # should be stored as part of data in GDS datastore
> + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+(custom_\w+)\=([^\s\"\']+)/g){
> + my $value = $2;
> + eval "\$value = \"$value\"";
> + $phase_form->{$1} = $value;
> + }
> + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+(custom_\w+)\=\"([^\"]*)\"/g ){
> + my $value = $2;
> + eval "\$value = \"$value\"";
> + $phase_form->{$1} = $value;
> + }
> + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+\"(custom_\w+)\=([^\"]*)\"/g){
> + my $value = $2;
> + eval "\$value = \"$value\"";
> + $phase_form->{$1} = $value;
> + }
> + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+(custom_\w+)\=\'([^\']*)\'/g ){
> + my $value = $2;
> + eval "\$value = \"$value\"";
> + $phase_form->{$1} = $value;
> + }
> + while ( $phase_form->{cmdline} =~ m/\s+-[x|e]\s+\'(custom_\w+)\=([^\']*)\'/g){
> + my $value = $2;
> + eval "\$value = \"$value\"";
> + $phase_form->{$1} = $value;
> + }
> +
> + # filling cached fields with prefix "cached_"
> + _fill_cached_info( $form );
> +
> + return 0;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _get_value {
> + my $name = shift @_;
> + my @sections = @_;
> +
> + my $ini = $MTT::Globals::Internals->{ini};
> +
> + # push (@sections, "MTT");
> + # push (@sections, "VBench");
> +
> + my $value = MTT::Values::Value( $ini, "VBench", $name );
> +
> + # my $value = VBench::Values::getValueFromSections($ini, $name, @sections);
> +
> + return $value;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _pre_process_phase {
> + my ( $phase, $section, $report, $form )=@_;
> +
> + my $ini = $MTT::Globals::Internals->{ini};
> + my $module = $ini->val( "Test run: " . $section, "analyze_module" );
> +
> + # If there's no analyze module, then just return
> + return $form
> + if (!$module);
> +
> + $module = "MTT::Test::Analyze::Performance::$module";
> + my $method = "PreReport";
> + my @args = ( $phase, $section, $report );
> +
> + Debug("Call PreReport on $module module.\n");
> +
> + my $str = "require $module";
> + my $check = eval $str;
> + if ($@) {
> + Warning("Could not load module $module: $@\n");
> + } else {
> + my $ret = undef;
> + $str = "\$ret = exists(\$${module}::{$method})";
> + eval $str;
> + if (1 == $ret) {
> + $ret = undef;
> + $str = "\$ret = \&${module}::$method(\@args)";
> + $check = eval $str;
> + if ($@) {
> + Warning("Could not run module $module:$method: $@\n");
> + }
> + }
> + }
> +
> + return $form;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _fill_cached_info {
> + my ( $form ) = @_;
> + my $phase_form = $form->{TestRunPhase};
> + my @info_list = ( "SubmitInfo", "ClusterInfo", "MpiInfo", "CompilerInfo", "SuiteInfo" );
> + my @exception_list = ( "clusterinfo_net_conf", "clusterinfo_net_pci" );
> +
> + foreach my $info (@info_list) {
> + foreach my $key (keys(%{$form->{$info}})) {
> + $phase_form->{lc("cached\_$info\_$key")} = $form->{$info}->{$key};
> + foreach (@exception_list) {
> + if (lc("$_") eq lc("$info\_$key")) {
> + delete($phase_form->{lc("cached\_$info\_$key")});
> + last;
> + }
> + }
> + }
> + }
> +
> + $phase_form->{"cached_mpiinstallphase_mpi_path"} = $form->{MpiInstallPhase}->{mpi_path};
> +
> + return $phase_form;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _fill_cluster_info {
> + my ( $phase, $section, $report, $form ) = @_;
> + $form->{ClusterInfo} = {};
> + my $info_form = $form->{ClusterInfo};
> +
> + if ( !defined($report) ) {
> + die "Runtime Error";
> + }
> + else {
> + my @sections;
> + push( @sections, "test run: " . $section );
> + push( @sections, "MTT");
> + push( @sections, "VBench");
> +
> + $info_form->{cluster_name} = $platform;
> +
> + my $node_count =
> + _get_value( "vbench:cluster_node_count", @sections );
> +
> + %$info_form = (%$info_form, %$clusterInfo);
> +
> + delete $info_form->{total_mhz};
> +
> + if (defined($node_count) && $node_count ne "") {
> + $info_form->{node_count} = $node_count;
> + }
> + }
> +
> + return $info_form;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _fill_mpi_info {
> + my ( $phase, $section, $report, $form ) = @_;
> + $form->{MpiInfo} = {};
> + # copy benchmark's additional data about mpi (filled in benchmark's analyzer)
> + %$form->{MpiInfo} = ( %$report->{mpi} ) if (exists ($report->{mpi}));#!!!!!!!!!!!!
> + my $info_form = $form->{MpiInfo};
> +
> + if ( !defined($report) ) {
> + die "Runtime Error";
> + }
> + else {
> + my @sections;
> + push( @sections, "test run: " . $section );
> +
> + my @mpi_name_parts =
> + split( /:/, $report->{mpi_install_section_name}, 1 );
> + $info_form->{mpi_name} = @mpi_name_parts[0];
> +
> + $info_form->{mpi_version} = $report->{mpi_version};
> +
> + my $mpi_path;
> + my $ini = $MTT::Globals::Internals->{ini};
> + my $mpi_section = $report->{mpi_install_section_name};
> +
> + my $mpiget_section = MTT::Values::Value( $ini, "MPI install: " . $mpi_section, "mpi_get" );
> +
> + my $mpiget_module = MTT::Values::Value( $ini, "MPI get: " . $mpiget_section, "module" );
> +
> + if ($mpiget_module eq "AlreadyInstalled") {
> + $mpi_path = MTT::Values::Value( $ini, "MPI get: ". $mpiget_section, "alreadyinstalled_dir" );
> + $mpi_path = EvaluateString( $mpi_path, $ini, "MPI get: ". $mpiget_section );
> + } else {
> + my $mpi_install = $MTT::MPI::installs->{$mpiget_section}->{$report->{mpi_version}}->{$mpi_section};
> + $mpi_path = $mpi_install->{installdir};
> + }
> +
> + my $error = 0;
> + my $cmd = "LD_LIBRARY_PATH=" . $mpi_path . "/lib " . $mpi_path . "/bin/mpirun --version";
> + open(SHELL, "$cmd 2>&1|") || ($error = 1);
> + $info_form->{oma_version} = "";
> + if ($error == 0) {
> + while (<SHELL>) {
> + if ( $_ =~ m/OMA\s+([r\d\.-]+)\s/) {
> + $info_form->{oma_version} = $1;
> + last;
> + }
> + }
> + close SHELL;
> + } # $error = 0
> + else {
> + $error = 0;
> + }
> +
> + # Add host file to "copy list"
> + if ( MTT::Values::Functions::have_hostfile() ) {
> + my $hostFile = MTT::Values::Functions::hostfile();
> + push(@{$report->{files_to_copy}}, $hostFile);
> + }
> + }
> + return $info_form;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _fill_suite_info {
> + my ( $phase, $section, $report, $form ) = @_;
> + $form->{SuiteInfo} = {};
> + # copy benchmark's additional data about benchmark suite (filled in benchmark's analyzer)
> + %$form->{SuiteInfo} = ( %$report->{suiteinfo} ) if (exists ($report->{suiteinfo}));#!!!!!!!!!!!!
> + my $info_form = $form->{SuiteInfo};
> +
> + if ( !defined($report) ) {
> + die "Runtime Error";
> + }
> + else {
> + my @sections;
> + push( @sections, "test run: " . $section );
> +
> + my $suite_name = undef;
> + my $suite_version = undef;
> +
> + my $test_run = $section;
> + if ( $test_run =~ m/^(\S+):(\S+)/ ) {
> + $suite_name = $1;
> + $suite_version = $2;
> + }
> + else {
> + if ( $test_run =~ m/^(\S+)\s(.+)$/ ) {
> + $suite_name = $1;
> + $suite_version = "undefined";
> + }
> + else {
> + $suite_name = $test_run;
> + $suite_version = "undefined";
> + }
> + }
> + $info_form->{suite_name} = $suite_name if (!defined($info_form->{suite_name}));
> + $info_form->{suite_version} = $suite_version if (!defined($info_form->{suite_version}));
> +
> + }
> + return $info_form;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _fill_submit_info {
> + my ( $phase, $section, $report, $form ) = @_;
> + $form->{SubmitInfo} = {};
> + my $info_form = $form->{SubmitInfo};
> +
> + if ( !defined($report) ) {
> + die "Runtime Error";
> + }
> + else {
> + if (!$local_username) {
> + $local_username = getpwuid($<);
> + }
> +
> + if (!defined($hostname) || "" eq $hostname) {
> + $hostname = `hostname`;
> + chomp($hostname);
> + }
> +
> + $info_form->{hostname} = $hostname;
> + $info_form->{local_username} = $local_username;
> + $info_form->{http_username} = $username;
> + $info_form->{mtt_version} = $MTT::Version::Combined;
> + }
> + return $info_form;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _fill_compiler_info {
> + my ( $phase, $section, $report, $form ) = @_;
> + $form->{CompilerInfo} = {};
> + my $info_form = $form->{CompilerInfo};
> +
> + if ( !defined($report) ) {
> + die "Runtime Error";
> + }
> + else {
> + $info_form->{compiler_name} = "unknown";
> + $info_form->{compiler_name} = $report->{compiler_name} if (defined($report->{compiler_name}));
> + $info_form->{compiler_version} = "unknown";
> + $info_form->{compiler_version} = $report->{compiler_version} if (defined($report->{compiler_version}));
> + }
> + return $info_form;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +sub _do_request {
> + my $req = shift;
> +
> + # Ensure that the environment is clean so that nothing happens
> + # that we're unaware of.
> + my %ENV_SAVE = %ENV;
> + delete $ENV{http_proxy};
> + delete $ENV{https_proxy};
> + delete $ENV{HTTP_PROXY};
> + delete $ENV{HTTPS_PROXY};
> +
> + # Go through each ua and try to get a good connection. If we get
> + # connection refused from any of them, try another.
> + my $response;
> + foreach my $ua (@lwps) {
> + Debug("MTTGDS client trying proxy: $ua->{proxy} / $ua->{source}\n");
> + $ENV{https_proxy} = $ua->{proxy}
> + if ("https" eq $ua->{scheme});
> +
> + # Do the HTTP request
> + $response = $ua->{agent}->request($req);
> +
> + # If it succeeded, or if it failed with something other than
> + # code 500, return (code 500 = can't connect)
> + if ($response->is_success() ||
> + $response->code() != 500) {
> + Debug("MTTGDS proxy successful / not 500\n");
> + %ENV = %ENV_SAVE;
> + return $response;
> + }
> + Debug("MTTGDS proxy unsuccessful -- trying next\n");
> +
> + # Otherwise, loop around and try again
> + Debug("Proxy $ua->{proxy} failed code: " .
> + $response->status_line . "\n" . $response->content . "\n");
> + }
> +
> + # Sorry -- nothing got through...
> + Debug("MTTGDS proxy totally unsuccessful\n");
> + %ENV = %ENV_SAVE;
> + return $response;
> +}
> +
> +#--------------------------------------------------------------------------
> +
> +# Create test file results, and prepare the HTTP file upload
> +# request
> +
> +my $request_count = 0;
> +
> +sub _prepare_request {
> + my ($phase, $report, $form, $attachment )=@_;
> +
> + my $ini = $MTT::Globals::Internals->{ini};
> + my $repository_path = MTT::Values::Value( $ini, "VBench", 'repository_tempdir' );
> + my $repository_name = MTT::Values::Value( $ini, "VBench", 'repository_dirname_prefix' );
> + my ($fh, $filename);
> + my $tmpdir;
> +
> + # Find a temporary directory for files
> + if (!defined($repository_path) || $repository_path eq '')
> + {
> + $tmpdir = tempdir( CLEANUP => 1);
> + ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.yaml' );
> + }
> + elsif (!defined($repository_name) || $repository_name eq '')
> + {
> + MTT::Files::mkdir($repository_path) if (! -d $repository_path);
> + $tmpdir = tempdir( DIR => "$repository_path", CLEANUP => 0);
> + ($fh, $filename) = tempfile( DIR => $tmpdir, SUFFIX => '.yaml' );
> + }
> + else
> + {
> + $request_count++;
> + MTT::Files::mkdir($repository_path) if (! -d $repository_path);
> + $tmpdir = "${repository_path}/${repository_name}_${request_count}";
> + $filename = "$tmpdir/${repository_name}_${request_count}.yaml";
> + }
> +
> + my $raw_filename = ();
> +
> + MTT::Files::mkdir($tmpdir);
> +
> + if ( keys %$attachment ) {
> + foreach my $file (keys %$attachment) {
> + Debug (" Attachment: $file\n");
> + MTT::Values::Functions::shell("cp -r $file $tmpdir/$attachment->{$file}");
> + }
> + $raw_filename = "$tmpdir/data_file.zip";
> + }
> +
> + # Generate YAML file contents
> + YAML::XS::DumpFile("$filename", $form);
> +
> + if ( $raw_filename ne '')
> + {
> + MTT::Values::Functions::shell(
> + "cd $tmpdir; zip -9 -r $raw_filename *");
> + }
> +
> + # Chech Google Datastore put entity limitation
> + $raw_filename = '' if 1048576 <= ((-s "$raw_filename") + (-s "$filename"));
> +
> + my $req;
> + # Create the "upload" POST request
> + if (-e $raw_filename)
> + {
> + $req = POST $url,
> + Content_Type => 'form-data',
> + Content => [
> + SUBMIT => 1,
> + data => ["$filename"],
> + raw => ["$raw_filename"],
> + description => "Submit data and raw on the phase <$phase>"
> + ];
> + }
> + else
> + {
> + $req = POST $url,
> + Content_Type => 'form-data',
> + Content => [
> + SUBMIT => 1,
> + data => ["$filename"],
> + description => "Submit data only on the phase <$phase>"
> + ];
> + }
> +
> + $req->authorization_basic($username, $password);
> +
> + return (\$req, $filename);
> +}
> +
> +1;
> _______________________________________________
> mtt-svn mailing list
> mtt-svn_at_[hidden]
> http://www.open-mpi.org/mailman/listinfo.cgi/mtt-svn

-- 
Jeff Squyres
jsquyres_at_[hidden]
For corporate legal information go to: http://www.cisco.com/web/about/doing_business/legal/cri/